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' HLP41ib.p4 

%% 

%% HLP41ib.p4: library of ProloglV accessory relations useful in High-Level API 

%% 

%% We follow the convention that the [conventional] result is bound to the first argument, 
%% so that these relations can be easily called as functions. 

%% 

%% Note: BEWARE: Interval operators (e.g. ./., .*., ...) sometimes give rise to errors (e.g. 
divide-by-zero error) 

%% in VB when used in conjunction with VB. 

%% Note: BEWARE: intsp 1 i t/r eal sp lit on unbounded variabes sometimes give rise to errors 
(e.g. overflow error) 

%% in VB when used in conjunction with VB. 

%% HLAPI-library functions/relations 

%% debug_print(-Result, +List): Result is true if it prints all the elements of 
the list, ended by nl 
debug_print(true, []) :- nl. 
debug_print(Result s [A| Rest]) :- 

write(A), write(V), 

debug_print(Result, Rest). 

%% var_with_precision(+V, +Prec): Succeeds if var V is an integer multiple of 
given Precision. 

%% (Do NOT introduce intsp lit(N) here - gives rise to overflow error in VB.) 
var_with_precision(V, Prec) :- 
int(N), 
V = N*Prec. 

%% even(-Result, +N): Result is true if N is an even integer. 
even(true, N) :- 
even(N). 

%% odd(-Result, +N): Result is true if N is an odd integer. 
odd(true, N) :- 
odd(N). 

%% max(-Result, +A, +B): Result is maximum of A and B. - already provided in 

ProloglV 

%% max(-Result, [A, B, C, ...]): Result is maximum of array of numbers [A, B, C, 

...]. 

max(Result, [A| Rest]) :- 

max_array_aux(Result, A, Rest). 
max_array_aux(A, A, []). 
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max_array_aux(Result, A, [B|Rest]) :- 
max(Rmax, A, B), 

max_array_aux(Result, Rmax, Rest). 

%% min(-Result, +A, +B): Result is minimum of A and B. — already provided in 

5 ProloglV 

%% min(-Result, [A, B, C, ...]): Result is minimum of array of numbers [A, B, C, 

...]. 

min(Result, [A| Rest]) :- 

min_array_aux(Result, A, Rest). 
10 min_array_aux(A, A, []). 

min_array_aux(Result ? A, [B|Rest]) :- 

min(Rmin, A, B), 

min_array_aux (Result, Rmin, Rest). 

%% mean(-Mean, A, B): Mean is mean of numbers A & B 
mean((A+B)/2, A, B). 

%% mean(-Mean, [A, B, C, ...]): Mean is mean of array of numbers [A,B,C,...] 

mean(A, [A]). 

mean(Sum/Size, [A|Rest]) :- 

array_sum(Sum, [A|Rest]), 
size(Size, [A|Rest]). 

4* %% median(-Med, +[A, B, C, ...]): Med is the median of array of numbers [A, B, 

C ...] 

L. median(Med, [A|Rest]) :- 
^ sort(SortedList, [A|Rest]), 

2$l size(Size, SortedList), 

TI pick_midlist(Med, SortedList, Size). 

□ pick_midlist(Mid, List, ListSize) :- 
p odd(ListSize), 

index(Mid, List, ((ListSize- 1 )/2)+ 1 ) . 
30 pick_midlist((Midl+Mid2)/2, List, ListSize) :- 

even(ListSize), 

index(Midl, List, ListSize/2), 

index(Mid2, List, (ListSize/2)+l). 

%% gcd(-GCD, +A, +B): GCD is gcd of A and B. -- until ProloglV provides 

35 it. 

gcdtemp(A./.Num, A, B) :- 

int(A), int(B), B gtlin 0, 
numden(A./.B, Num, _Den). 

%% lcm(-LCM, +A, +B): LCM is 1cm of A and B. (lcm(A, B)= A* B/ 
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gcd(A,B) )— until ProloglV provides it. 
lcmtemp((A.*.B)./.GCD, A, B) :- 

int(A), int(B), B gtlin 0, 

gcdtemp(GCD, A, B). 

%% mod(-Mod, N, D): Mod= N modulo M. 
modtemp(Mod, N, D) :- 
int(N), int(D), D gtlin 0, 
modulo(N, D, Mod). 

%% divmod(-DivMod, N, D): True if DivMod= [N Div D, N Mod D] 
divmod([Div, Mod] , N, D) :- 

int(N), int(D), D gtlin 0, 
intdiv(Div, N, D), 
modulo(N, D, Mod). 

%% numdentemp([-N, -D], R): True if N/D = R (where N and D are integers) 
numdentemp([N, D], R) :- 
real(R), 

numden(R, N, D). 

%% quotnumden([-Q, -N, -D], R): True if (Q+(N/D)) = R (where Q, N and D are 

integers) 

quotnumden([Q, N, D], R) :- 
real(R), 

numden(R,Nl,D), 
divmod([Q,N],Nl,D). 

%% sqrt(Sqrt, N): Sqrt is square-root of N ~ already provided by ProloglV 
%% is_perfect_square(-Result, +N): succeeds (and sets Result to true) if N is a 

perfect square. 

is_perfect_square(true, N) :- 
- int(N), int(Sqrt), 
sqrt(Sqrt, N). 

%% isnot_perfect_square(-Result, +N): succeeds (and sets Result to true) if N is 
NOT a perfect square. 
isnot_perfect_square(true, N) :- 

int(N), nint(Sqrt), 

sqrt(Sqrt, N). 

%% cubert(-CubeRoot, +N): CubeRoot is cube-root of N 
cubert(CubeRt, N) :- 
int(N), 

root(CubeRt, N, 3). 

%% is_perfect_cube(-Result, +N): succeeds (and sets Result to true) if N is a 
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perfect cube. 

is_perfect_cube(true, N) :- 
int(N), int(Cbrt), 
cubert(Cbrt, N). 

%% isnot_perfect_cube(-Result, +N): succeeds (and sets Result to true) if N is 
NOT a perfect cube. 
isnot_perfect_cube(true, N) :- 

is_perfect_cube(true, N), !, fail. 
isnot_perfect_cube(true 3 N) :- %% this alone does not work well because of roundoff 
problems 

int(N), nint(Cbrt), 
cubert(Cbrt, N). 

%% is_prime(-Result, +N): succeeds (and sets Result to true) if N is a 

prime-number. 

is_prime(true, 2). is_prime(true, 3). %% base cases (note that 1 is NOT considered prime.) 
is_prime(true, N) :- 

int(N), abs(AbsN 5 N), AbsN gt 3, 

sqrt(RlSqRoot, AbsN) 3 

cei^SqRoot, RISqRoot), 

aux_check_prime(AbsN, 2, SqRoot). 
aux_check_prime(N ? CurDi visor, MaxDi visor) :- 

CurDivisor gt MaxDivisor. 
aux_check_prime(N, CurDivisor, MaxDivisor) :- %% improve it later 

CurDivisor le MaxDivisor, 

modulo(N, CurDivisor, Mod), Mod gt 0, 

aux_check_prime(N, CurDivisor + 1, MaxDivisor). 

%% isnot_prime(-Result, +N): succeeds (and sets Result to true) if N is NOT a 

prime-number. 

isnotj»rime(true, N) :- 

nint(N), real(N). 
isnot_prime(true, N) :- 

int(N), abs(AbsN, N), AbsN gt 3, 

sqrt(RlSqRoot, AbsN), 

ceil(SqRoot, RISqRoot), 

aux_check_nonprime(AbsN, 2, SqRoot). 
aux_check_nonprime(N, CurDivisor, MaxDivisor) :- 

CurDivisor le MaxDivisor, 

modulo(N ? CurDivisor, 0), !. 
aux_check_nonprime(N, CurDivisor, MaxDivisor) :- 

CurDivisor le MaxDivisor, 

aux_check_nonprime(N, CurDivisor + 1, MaxDivisor). 
%% nth(-NthElem, +N, +List): NthElem is the Nth element of the given List; 
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(N=l for first elem.) 
nth(NthElem, N, List) :- 
index(NthElem, List, N). 

%% permute(-PermutedList, +List): PermutedList is a permutation of List. 
permute(PermutedList, List) :- 

permute_aux(PermutedList, [], List). 

permute_aux(PermutedList, PermutedList, []). 

permute_aux(PermutedList, APermutation, RightList) :- 
an_elem_and_rest(Elem, Rest, RightList), 
permute_aux(PermutedList, [Elem| APermutation], Rest). 

%% factorial(-Factorial, +N): Factorial N! 

%% naive implementation: factorial(l, 0). factorial(N* Fact, N) :- 
factorial(Fact, N-l). 

%% we just list them here which also gives a bidirectional relationship, 
factorial 1, 0). factorial 1, 1). factorial(2, 2). 
factorial(6, 3). factorial(24, 4). factorial 120, 5). 
factorial(720, 6). factorial(5040, 7). factorial(40320, 8). 
factorial(362880, 9). factorial(3628800, 10). 

factorial(399 16800, 11). factorial(479001600, 12). 
factorial(6227020800, 13). factorial(87 17829 1200, 14). 
factorial(1307674368000, 15). factorial(20922789888000, 16). 
factorial(35 5687428096000, 17). factorial(64023 73705 728000, 18). 
factorial(121645100408832000, 19). factorial(2432902008 176640000, 20). 
factorial(N* Fact, N) :- number(N), N gt 20, factorial(Fact, N-l). 

%% non-naive implementation of factorial - not used 
%% factorial 1, 0). 

%% factorial(Factorial, N) :- 
%% int(N), N gt 0, 

%% factorial(Factorial, N, N.-. 1 ). 

%%factorial(Factorial, Factorial, 0). 
%%factorial(Factorial, FactSoFar, N) :- 
%% N gt 0, 

%% factorial(Factorial, FactSoFar.*.N, N.-. 1). 

%% enumerate(-R, +Min, +Max, +Step): enumerate (any var) R between 
(closed-interval) [Min, Max] by Step. 
enumerate(R, Min, Max, Step) :- 

min(RMin, Min, Max), 

max(RMax, Min, Max), 

RMin le RMax, 
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Step gt 0, 

enumerate_aux(R, RMin, RMax, Step). 

%% enumerate_int(-I, +Min, +Max, +Step): enumerate (integer var) I between 
(closed-interval) [Min, Max] by Step. 
enumerate_int(I, Min, Max, Step) :- 
int(I), 

min(RMin, Min, Max), 
max(RMax, Min, Max), 
RMin le RMax, 
ceil(IMin, RMin), 
floor(IMax, RMax), 
IMin le IMax, 

floor(IStep, Step), %% should IStep be floor, or ceiling ?? 
IStep gt 0, 

enumerate_aux(I, IMin, IMax, IStep). 

%% enumerate_aux(-R, +Min, +Max, +Step): enumerate (any var) R between 
(closed-interval) [Min, Max] by Step. 

%% Note that we enumerate from both ends i.e. from Min and from Max ends. 
%% Note that increasing the no. of partitions requires large choice-stack and heap 

sizes. 

%% (We can adjust the various stack & heap sizes - but just that there is a cost to more 
partitions.) 

enumerate_aux(R, Min, Max, Step) :- 

StepsCnt= (Max- Min)/Step, 

StepsCnt le 4, %% le 4 partitions => le 5 points in the range 

!, %% small range - simple enumeration 

enumerate_aux_simple(R, Min, Min, Max, Step). 
enumerate_aux(R, Min, Max, Step) :- %% large range - interleave the enumeration 
StepsCnt= (Max- Min)/Step, %% adjust the Max 
floor(NMax, StepsCnt), 

PartitionStepCnt = StepsCnt/6, %% split the steps-range into 5 partitions 
floor(Inc, PartitionStepCnt), %% problem with ceil/2 when numbers are 

small 

enumerate_aux_interleave(R, %% interleave the 10 partitions 

[[Min, Min+ Inc* Step, inc], %% 1st: enumerate up 

[Min+(Inc+l)*Step, Min+2*Inc*Step, dec],%% 2nd: enumerate down 

[Min+(2*Inc-fl)*Step,Min+3*Inc*Step,inc], 

[Min+(3*Inc+l)*Step,Min+4*Inc*Step,dec], 

[Min+(4*Inc+l)*Step,Min+NMax*Step,decj], 
Step). 

%% enumerate R simply between Min & Max by Step 
enumerate_aux_simple(R, R, _Min, _Max, _Step). 
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enumerate_aux_simple(R, Prev, Min, Max, Step) :- 
(Prev-t- Step) le Max, 

enumerate_aux_simple(R, Prev+Step, Min, Max, Step). 

%% enumerate in an interleaved fashion - from all partitions - upward or 

downward 

enumerate_aux_interleave(RMin, [[RMin, RMax, inc]| _Rest], _Step)> 
RMin le RMax. 

enumerate_aux_interleave(RMax, [[RMin, RMax, dec]| _Rest], _Step):- 
RMin le RMax. 

enumerate_aux_interleave(R, [[RMin, RMax, _IncOrDec]| Rest], Step):- 

(RMin+ Step) gt RMax, !, %% partition done - drop it from the partitions-list 
random_shuffle(Shuffled, Rest), 
enumerate_aux_interleave(R, Shuffled, Step). 

enumerate_aux_interleave(R, [[RMin, RMax, inc]| Rest], Step):- 

random_shuffle(Shuffled, Rest), 

ncons(ResLst, [RMin+ Step, RMax, inc], Shuffled), 

enumerate_aux_interleave(R, ResLst, Step). 
enumerate_aux_mterleave(R, [[RMin, RMax, dec]| Rest], Step):- 

random_shuffle(Shuffled, Rest), 

ncons(ResLst, [RMin, RMax- Step, dec], Shuffled), 

enumerate_aux_interleave(R, ResLst, Step). 



%% select_r_of_n_ordered(-Pn_r, +N, +R): Select no. of permutations of setsize 
N selecting R at a time 

select_r_of_n_ordered(Nfact./. Rfact, N, R) :- 

int(N), int(R), N gt 0, R gt 0, N ge R, 
factorial(Nfact, N), 
factorial(Rfact, R). 

%% select_r_of_n(-Pn_r, +N, +R): Select no. of combinations of setsize N 
selecting R at a time 
select_r_of_n(Perm./. NRfact, N, R) :- 

select_r_of_n_ordered(Perm, N, R), 

factorial(NRfact, N-R). 

%% abs(-AbsN, +N): AbsN is absolute number, N. - already provided by 

ProloglV 



%% isbound(-Result, +X): Result is true if the given (numerical variable/value) X 
is bound on the low and/or upper side. 
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isbound(true, X) :- isbound(X). 
isbound(X) :- glb(X,_) , !. 
isbound(X) :- lub(X,J. 

%% isnotbound(-Result, +X): Result is true if the given (numerical variable) X 
NOT bound on either the low or the upper side. 
isnotbound(true, X) :- isnotbound(X). 
isnotbound(X) :- isbound(X), !, fail. 
isnotbound(X). 

%% auxiliary functions 

%% even(N): true if N is even 
even(2*.X) :- int(X). 

%% odd(N): true if N is odd 
odd(N) :- int(N), N= 2 *.X, nint(X). 

%% reverse(-ReverseList, +List): ReverseList is reverse-ordered List 
reverse(ReverseList, List) :- 

reverse(ReverseList, [], List). 
reverse(ReverseList, ReverseList, []). 
reverse(ReverseList, RevListSoFar, [A|Rest]) :- 

reverse(ReverseList ? [A|RevListSoFar], Rest). 

%% ncons(-ResList, +A, +List): true if ResList= List+ [A]. 
ncons(ResList, A, List) :- 

append(ResList, List, [A]). 

%% append(-AppendedList, Listl, List2): AppendedList is result of appending 
lists Listl & List2. 
append(A, [], A). 

append([A|Result], [A|Rest], B) :- 
append(Result, Rest, B). 

%% random_shuffle(-ShuffledList, +List): Succeeds if List is random- shuffled 
into SuffledList 

random_shuffle(ShuffledList, List) :- 

random_shuffle(ShuffledList, [], List). 

random_shuffle(ShuffledList, ShuffledList, []). 
random_shuffle(ShuffledList, ShuffledListSoFar, [A| Rest]) :- 

brandom(Random), 

((Random=l) -> 

random_shuffle(ShuffledList, [A| ShuffledListSoFar], Rest); 
(ncons(NewShuffledListSoFar, A, ShuffledListSoFar), 
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random_shuffle(ShuffledList, NewShuffledListSoFar, Rest) ) 
)• 

5 %% array_sum(-ArraySum, + Array): Sum is the sum of the array-elements of 

Array 

array_sum(0, []). 

array_sum(ArraySum, [A|Rest]) :- 
number(A), 

10 array_sum(ArraySum, A, Rest). 

array__sum(ArraySum, ArraySum, []). 
array_sum(ArraySum, SumSoFar, [A|Rest]) :- 
number(A), 

array_sum(ArraySum, SumSoFar.+.A, Rest). 

15 %% sort(-SortedArray, + Array): Array (of numbers) is sorted (in ascending order) 

into SortedArray 
sort([], []). 

□ sort(SortedArray, [E|Array]) :- %% quicksort 

jg partition_mine(Smaller, Greater, E, Array), 

2Ql sort(SortedSmaller, Smaller), 

yi sort(SortedGreater, Greater), 

4" append(SortedArray, SortedSmaller, [E|SortedGreater]). 

HF %% partition(-Smaller, -Greater, +Elem, + Array): Partition the Array (of 

^ numbers) into 
2pL, %% subarrys Smaller and Greater than Elem. 

J partition_mine([], [], []). 

partition jTiine([Small|Smaller], Greater, Elem, [Small|Array]) :- 

Small le Elem, %% Small<= Elem, 

p partition_mine(Smaller, Greater, Elem, Array). 

3g| partition_mine(Smaller, [Great|Greater], Elem, [Great|Array]) :- 

Great gt Elem, %% Great > Elem 

partition_mine(Smaller, Greater, Elem, Array). 

%% rotate(-RotatedList, +List, +N): Rotate the given List by N steps into 

RotatedList. 
35 rotate([], [], J. 

rotate(RotatedList, List, N) :- 

first_N_elems(FirstNElems, RestElems, List, N), 

append(RotatedList, RestElems, FirstNElems). 

40 %% first_N_elems(-FirstNElems, -RestElems, +List, +N): true if List = 

FirstNElems + RestElems. 
first_N_elems([], List, List, 0). 
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first_N_elems([], [], [], _N). 

first_N_elems([A| NextElems], RestElems, [A| Rest], N) :- 
int(N),Ngt 0, 

first_N_elems(NextElems, RestElems, Rest, N.-.l). 

%% one_of(Elem, List): true if Elem is an element of the given List 

%%one_of(Elem, List) :- %% this implementation has some disadvantages 

%% inlist(Elem, List). 

one_of(Elem, [Elem| _]). 
one_of(Elem, [_|List]) :- 
one_of(Elem, List). 

%% not_one_of(Elem, List): true if Elem is not an element of the given List 
not_one__of(Elem, List) :- 
outlist(Elem, List). 

%% an_elem_and_rest(Elem, Rest, List): true if Elem is an element of the List, 
and Rest= List- Elem. 
an_elem_and_rest(Elem, Rest, List) :- 

an_elem_and_rest_aux(Elem, Rest, [], List). 
an_elem_and_rest_aux(A, Rest, LeftList, [A| Remainder]) :- 

append(Rest, LeftList, Remainder). 
an_elem_and_rest_aux(Elem, Rest, LeftList, [A|Remainder]) :- 

append(NewLeftList, LeftList, [A]), 

an_elem_and_rest_aux(Elem, Rest, NewLeftList, Remainder). 



%% random(-Elem, +List): return a random element (Elem) from the given list 
random(Elem, List) :- 
list(List), 

random_shuffle(ShuffledList, List), 
one_of(Elem, ShuffledList). 

%% random(-Random, +Range): return a random number in the range 0 ... Range 
random(Rand, Range) :- 

int(Range), Range> 0, 
random(R), 

modulo(R, Range+1, Rand). 

%% brandom(-BRandom): True if BRandom is a binary (i.e. 0 or 1) random number 
brandom(BRand) :- 
random(Rand), 

(((Rand/2147483647)>= 0.5) -> BRand = 1; BRand = 0). 
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%% random(-Random): True if Random is a (pseudo-) random integer 
%% 

%% Note that this works because ProloglV can handle numbers greater than 32-bits 
randomize(S) :- integer(S), record(seed, S). 
random(X) :- 

recorded(seed, S), 

(integer(S) -> SI = S; Sl= 1), 

Z= SI* 16807, 

modulo(Z, 2147483647, X), 

record(seed, X). 

%% KNJ: Seems like a very inadequate randomizer: we get numbers 7n+4 from it ! ! 
%% As such, you will have (for this randomizer): random()% 7= 4. 

%% — Not used any more : KNJ — 

%% KNJ: Modified the multiplier to a prime-no, and that seems to have improved the 
generator. 

%%%%%%%%% 

% Random number generator from Pascal Bouvier of PrologIA : 
%-- random.p4 -- 

% un generateur de nombres pseudo-aleatoires. 
% A pseudo-random number generator. 
% (formula got from C-ANSI random() ?) 

% 

% Pascal Bouvier, d'apres Prolog III 
%(c) PrologIA 1996,1997 

% initializer 

orandomize(S) :- integer(S) ,!, record(oseed, S). 
orandomize(S) :- var(S), record(oseed, 1). 
orandom(X) :- 

recorded(oseed,S), 

(integer(S) -> SI = S ; SI = 1), 

Z = S1*1103515245 + 12345, 

modulo(Z, 65536*65536-1, Zl), 

record(oseed,Zl), 

modulo(Z,32767, X). 



%%%%%%%%% 



PROLOG SCA-11- 



THIS PAGE BLANK (uspto) 



PROLOG SCA -12- 



' PrlgExpr.l 
/* 

* PrlgExpr.l: Lexical analyzer for constraints: 

* (splits constraints into lexical-components e.g. words, punctuations). 



*/ 
%{ 

#include <math.h> 
#include <malloc.h> 
#include <string.h> 
#include "p4term.h" 
#include "prlgHLAPI.h" 
#include "PrlgExpr.tab.h" 

extern int GetInString(char *buf, int max_size); 

//extern int yylval; - supplanted by "extern YYSTYPE yylval;" in PrlgExpr.tab.h 

#define YY_INPUT(buf, result_cnt, max_size) {if ( ! (result_cnt= GetInString(buf, 
max_size))) {buf[0]= YY_NULL; result_cnt= 1;} } 

#defme MAX_VAL_BUF 64 
static charvalBuf[64][MAX_VAL_BUF]; 
static int valBuf_x= 0; 

#defme New_VAL_BUF ((valBuf_x< MAX_VAL_BUF)? valBuf[valBuf_x++] 

(valBuf_x= 0, valBuf[valBuf_x++])) 

//#define STRDUP(str) (strcpy(New_VAL_BUF, (str))) 

#define STRDUP(str) (strdup(str)) 



/* 

Note that, in flex, predefined char, classes (which must appear within [ ]) include: 



* 



%} 



UPPER 

LOWER 

ALPHA 

ALNUM 

DIGIT 

SPACE 

*/ 



[A-Z] [:upper:] 
[a-z] [: lower:] 
[a-zA-Z] [: alpha:] 



[0-9] 



[A-Za-zO-9] [:alnum:] 

[:digit:] 
[\\n\\r\\t\\v\\f\\0 ] [:space:] 



%% 

"end_var_defs" 
return(END_VAR_DEFS); } 
"freeze" 

return(FREEZE);} 



{yylval.ival= END_VAR_DEFS; 



{yylval.ival= FREEZE; 
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"succeed" 

retum(SUCCEED);} 
"fail" 

return(FAIL);} 
"if 

retum(IF);} 
"then" 

return(THEN);} 
"else" 

return(ELSE);} 
"elseif" 

return(ELSEIF);} 
"int(" 

return(INT_PRED);} 
"real(" 

return(RE AL_PRED) ; } 
"fraction(" 

return(FRACTION_PRED) ; } 
"list(" 

return(LIST_PRED);} 
"eq_vars(" 

return(EQVARS_PRED);} 
"neq_vars(" 

return(NEQVARS_PRED); } 



{yylval.ival= SUCCEED; 
{yylval.ival= FAIL; 

{yylval.ival= IF; 
{yylval.ival= THEN; 
{yylval.ival= ELSE; 
{yylval.ival= ELSEIF; 
{yylval.ival= INT_PRED; 
{yylval.ival= REAL_PRED; 
{yylval.ival= FRACTIONPRED ; 

{yylval.ival= LIST_PRED; 
{yylval.ival= EQVARSPRED; 
{yylval.ival= NEQVARSPRED; 
{yylval.ival= NEQ V ARV ALSPRED ; 



"neq_varvals(" 
return(NEQVARVALS_PRED);} 

"optimizable_rel(" {yylval.ival= OPTIMIZ ABLERELPRED ; 

return(OPTIMIZABLEREL_PRED); } 
"step" 

retum(STEP);} 
"symbol(" 

S YMBOL PRED ; return(S YMB OL_PRED) ; } 



"pi" 



(float)PI; return(PI);} 



"in" 



IN_SET; retum(IN_SET);} 
"from" 

FROM_SET; return(FROM_SET);} 
"notin" 

NOTIN_SET; return(NOTIN_SET);} 
"not" 

return(NOT);} 

n___M 

return(EQ);} 



{yylval.ival= STEP; 
{yylval.ival= 

{yylval.fVal= 
{yylvalival= 
{yylval.ival= 
{yylval.ival= 
{yylval.ival= NOT; 
{yylval.ival= EQ; 
{yylval.ival= NEQ; 
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10 



15 



2ftj 

ul 



return(NEQ);} 

return(GE);} 

return(LE);} 
"[!" 

EXRANGE_START; return(EXRANGE_S TART) ; } 
[[:upper:]_][[:alnum:]_]* 
return(VAR);} 
[[:lower:]][[:alnum:]_]* 
return(ATOM_CONST);} 
[[:digit:]]*"."[[:digit:]]+ 
string-rep */ return(RE ALNUM); } 
[[:digit:]]+ 
return(INTNUM);} 
[[:space:]]+ 

yytext[0]; return(yytext[0]);} 

%% 

intyywrapQ {return(l);} 



{yylval.ival= GE; 
{yylval.ival= LE; 
{yylval.ival= 
{yylval.string= STRDUP(yytext); 
{yylval.string= STRDUP(yytext); 
{yylval.string- STRDUP(yytext); /* stuffs 
{yylval.ival= atoi(yytext); 
{continue;} 

{yylval.ival= 
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' PrlgExpr.y 

%{ 
/* 

* PrlgExpr.y: Parser for Prolog constraints - to provide functionality for 

5 * high-level communication, using mathematical expressions, between 

* Prolog IV and other programs (e.g. TCA-GUI). 

* (Use: bison -vd PrlgExpr.y to process it.) 
* 

/ 

10 #include <stdio.h> 

#include <time.h> 

#include <string.h> 

#include <malloc.h> 

#include "p4term.h" 
15 #include "prlgHLAPI.h" 

#define CHECK CNT // «-- define 

f i it to check any buffer-overflows 

5 #define VERSION "3.3f //«-- update it appropriately 
Gl #define P4HLAPILIB "HLP41ib.p4" 

2Q": #define TRUE 1 

#define FALSE 0 

4» #define PI_VAL (3.14159265) 

6 #define MAX(a, b) ((a)>=(b)? (a):(b)) 
L #define MIN(a, b) ((a)<=(b)? (a):(b)) 

?M #define ABS(x) ((x)>= 0? (x): -(x)) 

X #define list(elem) (cons((elem), NULL)) 
J #define SAME(x, y) (ABS((x)-(y))<= (Precision)) 

// sizes for some of P4 stacks in terms of cells (1 cell = 8 

bytes) 

30 #defme P4HEAP_SIZE (1000000) /* 

P4-heap-stack-size in cell (= 8 bytes) counts [default: 700000] */ 
#define P4CHOICE_SIZE (300000) /* 

P4-choice-stack-size in cell (= 8 bytes) counts [default: 50000] */ 

#define p4val_rational(T) (p4val_as_double(T)) 
35 #define p4val_cstring(T) (p4_symbol_to_cstring(p4val_symbol(T))) 

#ifdefCHECK_CNT 

static P4TERM check_term(P4TERM term)\ 

{if (!term) printf("\n***Received NULL P4TERM***\n");\ 

if (p4errno!= 0) {printf("\n***Unknown error occurred before the given term was 
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checked;***\n");fflush(stdout);}\ 

return term;} 

#else 

#define check term(term) (term) 

#endif /* CHECK CNT */ 

#define P4MAKE_FUNC_0(func_str) 

check_term(p4make_atom(p4str2symbol(func_str))) 
#defme P4MAKE_FUNC_l(func_str, arg) 
checkJerm(p4make_functor(l, p4str2symbol(func_str), (arg))) 

#define P4MAKE_FUNC_2(func_str, arg 1 , arg2) check Jerm(p4make_functor(2 , 

p4str2symbol(func_str), (argl), (arg2))) 

#define P4MAKE_FUNC_3(func_str, argl, arg2, arg3) 

check_term(p4make_functor(3, p4str2symbol(func_str), (argl), (arg2), (arg3))) 

#define P4MAKE_FUNC_4(func_str, argl, arg2, arg3, arg4) 

check_term(p4make_functor(4, p4str2symbol(func_str), (argl), (arg2), (arg3), (arg4))) 

#define P4 AND(arg 1 , arg2) ((arg 1 ) && 

(arg2)? P4MAKE_FUNC_2(",", argl, arg2): (argl)? (argl): (arg2)) 

#define P4C0MMA(argl , arg2) (P4AND(argl , 

arg2)) 

#define P40R(argl , arg2) ((arg 1 ) && 

(arg2)? P4MAKE_FUNC_2(";", argl, arg2): (argl)? (argl): (arg2)) 

#define P4EQ(argl , arg2) ((arg 1 ) && 

(arg2)? P4MAKE_FUNC_2("=", argl, arg2): (argl)? (argl): (arg2)) 

#define P4NEQ(arg 1 , arg2) ((arg 1 ) && 

(arg2)? P4MAKE_FUNC_2("dif, argl, arg2): (argl)? (argl): (arg2)) 

#define P4IF_THEN(cond_t, thenj) (P4MAKE_FUNC_2("->", condj, 

thent)) 

#define P4IF_THEN_ELSE(cond_t, thenj, elsej) (P40R(P4IF_THEN(cond_t, then_t), 

elsej)) 

#define P4IF_THEN_ELSEIF(then_cond_t, thenj, else_cond_t, elsej) 
(P40R(P4AND(then_cond J, thenj), P4AND(else_condJ, elsej))) 
#define P4NOT(arg) 
(P4MAKE_FUNC_1("\\+", arg)) 
#define P4CUT 

(P4M AKE_FUNC_0(" ! ")) 
#define P4TRUE 

(P4MAKE_FUNC_0("true")) 
#define P4FAIL 

(P4MAKE_FUNC_0("fail")) 
#define P4FALSE 

(P4FAIL) 

// need to wrap goal in p4call/l before calling p4make_call() (to interpret +12, -12, ...) 
#define P4MAKE_CALL(goal) (p4make_call(P4MAKE_FUNC_l ("p4call", goal))) 
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// due to a bug in p4what_is(), need to call dereference 
#defme P4WHAT_IS(term) (p4what_is(dereference(term))) 



// max. size (in bytes) of an expression passed to the API 
#define MAX_EXPR_SIZE 4096 

// max no, of variables (in one call to Prolog IV) 
#define MAX_VAR_CNT 1 024 

// max. length of variable name 
#define MAX_VAR_NAME_LEN 32 

// max-size of the funcTermBuf[] 
#define MAX_FUNC_TERM_BUF_CNT 128 

// max-size of the anonVarBuf[] 
#define MAX_ANON_VAR_CNT 128 

// max-size of the constBuf[] 
#define MAX_CONST_CNT 1 28 

// max. arity of a functor 
#defineMAX ARITY 10 



#define random rand // MS VC does not 

have random() ~ remove when we can have random() 

#define srandom srand // MS VC does not 

have srandom()-- remove when we can have random() 

//extern void srandom(long); 

//extern long random(); 

extern double atof(); 

//extern int isspace(); 

extern int p4errno; 



#ifdef PRLGHLAPI 

declspec(dllexport) long AbortPrologSoln; // Flag; if TRUE, Prolog 

constraint-solving-process is aborted 
#else 

long AbortPrologSoln; // Flag; if TRUE, Prolog constraint-solving-process is aborted 
#endif// PRLGHLAPI 

//typedef char BOOLEAN; 

static struct s_rename_struct // used in make_functor() 

{ 

char *func_name, *map_to_name; // for mapping func-names e.g. gcd -> 

gcdtemp 

} FuncRenameList[]= { 

{"ceiling", "ceil"}, 
{"gcd", "gcdtemp"}, 
{"lcm", "lcmtemp"}, 
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{"mod", "modtemp"}, 
{"numden", "numdentemp"}, 

{NULL, NULL} } ; // make sure to end the list with {NULL, NULL} 

typedef struct s_tabelem 

{ // an element of the name-key table 

char type; // user-specified type (e.g. int(X)) of the variable; 0 if any type will do. 

char ongrid; // flag: true if var- value is to be an integral multiple of its precision; false 
otherwise 

double precision; // precision for the variable 

char name[MAX_VAR_NAME_LEN+ 1 ] ; // variable name 

P4TERM term; // P4 Prolog term representation for the variable 

struct s_tabelem *next; 

char is_independent_var; // TRUE if the variable is independent (& is not a 

constant); FALSE otherwise 
} TabElem; 

typedef struct s_constant 

{ 

P4TERM term; 
Value value; 
} Const; 

static char inExprBufIMAX_EXPR_SIZE+l]= {0} ; // buffer to store the incoming 

expression (string) in - for parsing purposes 
static int inExprBuf_x= 0, inExprBuf_cnt= 0; 

#define INITinExprBuf {inExprBuf_cnt= inExprBuf_x= 0;} 

// buffer to store func-terms for arity conversion (i.e. X= func(Y, Z). -> X= _R, 
func(_R, Y, Z).) 

static P4TERM funcTeimBuf[MAX_FUNC_TERM_BXJF_CNT]= {NULL}; 
static int funcTermBuf_x= 0; 

#define INIT funcTermBuf {funcTermBuf_x= 0; memset(funcTermBuf, 0, 

MAX_FUNC_TERM_BUF_CNT* sizeof(P4TERM));} 

#ifdefCHECK_CNT 

#define ADD_funcTermBuf(term) {if (funcTermBuf_x< MAXFUNCTERMBUFCNT) 
funcTermBuf[funcTermBuf_x++]- (term); else {printf("\n* * *FUNC_TERM_BUF 
overflow***\n");fflush(stdout);} } 
#else 

#define ADD_funcTermBuf(term) {funcTeimBuf[funcTermBuf_x++]= (term);} 
#endif /* CHECK CNT */ 

#define FOR_EACH_FUNC_TERM(term) {int _i_func; for(_i_func= 0; _i_func< 

funcTermBuf_x && ((term)= funcTermBufT_i_func]); _i_func++) { 
#define END_FOR_EACH_FUNC_TERM(term) }} 
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// buffer for anonymous var's used in the functions 
static P4TERM anonVarBuf[MAX_ANON_VAR_CNT]= {NULL}; 
static int anonVarBuf_x= 0; 

#define INIT_anonVarBuf {anonVarBuf_x= 0; memset(anonVarBuf, 0, 

MAX_ANON_VAR_CNT* sizeof(P4TERM));} 

#ifdefCHECK_CNT 

#define ADD_anonVarBuf(anon_term) {if (anonVarBuf_x< MAXAN ONV ARCNT) 
anonVarBuf[anonVarBuf_x++]= (anonjerm); else {printf("\n***ANON_VAR_BUF 
overflow***\n");fflush(stdout);} } 
#else 

#define ADD_anonVarBuf(anon_term) {anonVarBuf[anonVarBuf_x++]= (anonjerm);} 
#endif /* CHECK_CNT */ 

#define FOR_EACH_ANON_VAR(anon_term) {int _i_anon; for(_i_anon= 0; (_i_anon< 
anonVarBuf_x) && ((anon_term)= anonVarBuf[_i_anon]); _i_anon++) { 
#define END_FOR_EACH_ANON_VAR(anon_term) }} 

// buffer to store number-constant's (with their values) 
static Const constBuf[MAX_CONST_CNT]= {0}; 
static int constBuf_x= 0; 

#define INIT_constBuf {constBuf_x= 0; } 

#ifdefCHECK_CNT 

#define ADD_constBuf(trm, const_val) {if (constBuf_x< MAX_CONST_CNT) 
{constBuf[constBuf_x].term= (trm); constBufIconstBuf_x].value= (const_val);constBuf_x++;} 
else {printf("\n***CONST_BUF overflow***\n");fflush(stdout);}} 
#else 

#define ADD_constBuf(trm, const_val) {constBuf[constBuf_x].term= (trm); 
constBuf[constBuf_x].value= (const_val); constBuf_x++;} 
#endif /* CHECK_CNT */ 

// setup to allocate TabElem's from a circular buffer - quick, easy to reinitialize, 
& no need to free up pointers 

static TabElem tabSpace[MAX_VAR_CNT]= {0} ; // space to alloc TabElem from 
static int tabSpace_x= 0; 

// alloc a new TabElem from a circular buffer 
#ifdefCHECK_CNT 

#define NEW_TAB_ELEM ((tabSpace_x< MAX_VAR_CNT)? &tabSpace[tabSpace_x++] : 
(tabSpace_x= 0, printf("\n***tabSpace-buffer overflow** *\n"), fflush(stdout), 
&tabSpace[tabSpace_x++])) 
#else 

#defme NEW_TAB_ELEM ((tabSpace_x< MAX VAR CNT)? &tabSpace[tabSpace_x++]: 
(tabSpace_x= 0, &tabSpace[tabSpace_x++])) 
#endif /* CHECK_CNT */ 

// [rejintialize the table 
#define INIT_tabSpace {tabSpace_x= 0; memset(tabSpace, 0, 

MAX_VAR_CNT*sizeof(TabElem));} 
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// [hash] table for Var's 
#define VARTABLESIZE 53 
static TabElem *varTable[VAR_TABLE_SIZE] = {NULL}; 

// varList: array of var's from the current constraint e.g. X, Y from "X= Y+2, 

5 Y=6." 

static TabElem *varList[MAX_VAR_CNT]= {NULL}; 
static int varList_x= 0; 

// add the given TabElem-ptr to the varList 
#ifdefCHECK_CNT 

1 0 #define ADD_varList(p_tabElem) {if (varList_x< MAX_VAR_CNT) varList[varList_x++]= 
(ptabElem); else {printf("\n***varList-buffer overflow***\n");fflush(stdout);}} 
#else 

#define ADD_varList(p_tabElem) {varList[varList_x-H-]= (p_tabElem);} 
#endif /* CHECK_CNT */ 
15 // [re] intialize the varList 

#define INIT_varList {varList_x= 0;} 
#define var_CNT (varList_x) 

// initialize all the variable-related space 

m #define INIT_vars {memset(varTable, 0, 

201 VAR_TABLE_SIZE*sizeof(TabElem *)); INIT_varList; INITjabSpace;} 
4= // to do something for each var in current constraint; sets p_tab_elem & its index 

C ! in varList 

4» #defme FOR_EACH_VAR(p_tab_elem, x) {int _i_var; for(_i_var= 0; ((x)=_i_var)< 

® var_CNT && ((p_tab_elem)= varList[_i_var]); _i_var++) { 

2L #define END_FOR_EACH_VAR(p_tab_elem, x) }} 



n 

o 



// buffer for return values 
#define MAX_VAL_BUF_LEN ( 1 024) 

static Value valBuf[MAX_VAL_BUF_LEN]; 
O static int valBuf_x= 0; 
30" #ifdefCHECK_CNT 

#define NEW_VALUE ((valBuf_x< MAX_VAL_BUF_LEN)? 

&valBuf[valBuf_x++]: (valBuf_x= 0, printf("\n***valBuf-buffer overflow***^"), 
fflush(stdout), &valBuf[valBuf_x++])) 
#else 

35 #define NEWVALUE ((valBuf_x< MAX_VAL_BUF_LEN)? 

&valBuf[valBuf_x++]: (valBuf_x=0, &valBuf[valBuf_x++])) 
#endif /* CHECK CNT */ 
#define INITvalBuf {valBuf_x= 0;} 

// buffer for enumerated-range terms 
40 #define MAX_ENUM_RANGE_TERMS (128) 

static P4TERM enumRangeTermBuf[MAX_ENUM_RANGE_TERMS]= {NULL}; 
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static int enumRangeTermBuf_x= 0; 

#define enumRangeTermBuf_CNT (enumRangeTermBufx) 
#define INIT_enumRangeTermBuf {enumRangeTermBuf_x= 0;} 
#ifdefCHECK_CNT 

#define ADD_ENUM_RANGE_TERM(term) {if (enumRangeTermBuf_x< 
MAX_ENUM_RANGE_TERMS) enutnRangeTermBuf[enumRangeTermBuf_x++]= (term); 
else {printf("\n***enumRangeTermBuf overflow***W');fflush(stdout); } } 
#else 

#define ADD_ENUM_RANGE_TERM(term) 
{enumRangeTermBuf[enumRangeTermBuf_x-H-]= (term);} 
#endif /* CHECK_CNT */ 

#define ENUM_RANGE_TERM(x) (((x)< enumRangeTermBuf_CNT) && 

((x)>= 0)? enumRangeTermBuf[x] : NULL) 

#define FOR_EACH_ENUM_RANGE_TERM(term, x) {int _i_vrange; for(_i_vrange= 0; 
(((x)=_i_vrange)< enumRangeTermBuf x) && ((term)= enumRangeTermBuiT_i_vrange]); 
_i_vrange++) { 

#defme END_FOR_EACH_ENUM_RANGE_TERM(term, x) } } 

// swap the positions of the terms (given by their indices in the buffer) in 
the variable-range buffer 

#define SWAP_ENUM_RANGE_TERMS(term_x, term_y) {P4TERM _t_vrange;\ 

if (((term_x)< enumRangeTermBuf_CNT) && ((term_y)< enumRangeTermBuf_CNT)) {\ 

_t_vrange= enumRangeTermBuf[term_x]; enumRangeTermBuf[term_x]= 
enumRangeTermBuf[term_y] ;\ 

enumRangeTermBuf[term_x]= _t_vrange;\ 

}} 

// buffer for var-type (e.g. int(X); eq_vars(X, Y); neq_vars(X, Y,Z) ) terms 
#define MAX_VAR_TYPES_TERMS (128) 

static P4TERM varTypesTermBuf[MAX_VAR_TYPES_TERMS]- {NULL}; 
static int varTypesTermBuf_x= 0; 

#define varTypesTermBuf_CNT (varTypesTermBuf_x) 
#defme INIT_varTypesTermBuf {varTypesTermBuf_x= 0;} 
#ifdefCHECK_CNT 

#define ADD_VAR_TYPES_TERM(term) {if (varTypesTermBuf_x< 
MAX_VAR_TYPES_TERMS) varTypesTermBuf[varTypesTermBuf_x-H-]= (term); else 
{printf("\n***varTypesTermBufoverflow***\n , ');fflush(stdout);}} 
#else 

#define ADD_VAR_TYPES_TERM(term) {varTypesTermBuf[varTypesTermBuf_x++]= 
(term);} 

#endif /* CHECK CNT */ 

// buffer for storing solutions so we can return solutions in some (e.g. 
breadth-first) order 

#define MAX_SOLN_BUF_LEN ( 1 024) 

// the soln-buffer really is an array of vectors of solutions (e.g. [[xl,yl],[x2,y2],...] 
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// (we take the vector-width to be the no. of variables in the constraint= 

varList_x) 

static Value solnBuf[MAX_SOLN_BUF_LEN]; 

static Value tmpsolnBuf[MAX_SOLN_BUF_LEN/2]; // tmp solution buffer - useful for 
5 shuffling solutions 

static int solnVec_x= 0, solnCnt= 0, curSoln_x= 0, doBufferSoln= FALSE; 

#define INIT_solnBuf {solnVec_x= 0; solnCnt= 0; curSoln_x= 0; doBufferSoln= 

FALSE;} 

#define NEW_SOLN_VECTOR ((var_CNT<= 0)? NULL:\ 

10 ((solnVec_x< 

(int)(MAX_SOLN_BUF_LEN/var_CNT))? &solnBuf[var_CNT*solnVec_x++] : NULL)) 
#define SOLN_VECTOR_SIZE (var_CNT*sizeof(Value)) 
#defme SET_BUF_SOLN_CNT(soln_cnt) {solnCnt= (soln_cnt);} 

// ptr to the value (by its index from the varList) of a variable in specified solution 
(by its index) in the solnBuf 
#defme p_VAR_VALUE_in_solnBuf(soln_x, var_x) (((soln_x)>= solnCnt)? NULL: 
(((var_x)< var_CNT)? &solnBuf[var_CNT*(soln_x)+ (var_x)]: NULL)) 

// ptr to the value (by its index from the varList) of a variable in current-solution 
ri #define CUR_BUF_SOLUTION(var_x) p_VAR_VALUE_in_solnBuf(curSoln_x, 
2CH var_x) 

01 #define NEXT_BUF_SOLUTION ((curSoln_x>= (solnCnt-1))? NULL: 

Ul &solnBuf[varList_x*++curSoln_x]) 

M #defme FOR_EACH_SOLN_VECTOR(p_soln_vec, x) {int _i_solnx; for(_i_solnx= 0; 
tf! (((x)=_i_solnx)< solnCnt) && ((p_soln_vec)= &solnBuf[var_CNT*_i_solnx]); _i_solnx++) { 
2fP #define END_FOR_EACH_SOLN_VECTOR(p_soln_vec, x) }} 

// swap the specified (by their indices) solutions (value-vectors) in the solnBuf 
!L #defme SWAP_SOLUTIONS(soln_i, solnj')\ 
h? if ((soln_i)< solnCnt && (solnJ)< solnCnt)\ 

a ^ 

3(K Value tmp; int x;\ 

Pi for(_x= 0; _x< var_CNT; _x++)\ 

5 i\ 

_tmp= *p_VAR_VALUE_in_solnBuf(soln_i, _x);\ 
*p_VAR_VALUE_in_solnBuf(soln_i, _x)= 
35 *p_VAR_VALUE_in_solnBuf(solnJ, _x);\ 

*p_VAR_VALUE_in_solnBuf(solnJ, _x)= _tmp;\ 

}\ 

} 

// move the specified (by its from & to-index) solution in the solnBuf 
40 #define MOVE_SOLUTION(to_soln_x, from_soln_x)\ 
if ((to_soln_x)< solnCnt && (from_soln_x)< solnCnt)\ 

{\ 

int x;\ 

for(_x= 0; _x< var_CNT; _x++)\ 
45 {\ 
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*p_VAR_VALUE_in_solnBuf(to_soln_x,_x)= 
*p_VAR_VALUE_in_solnBuf(from_soln_x,_x);\ 

}\ 

// copy the specified (by its index) solution from solnBuf into the tmpsolnBuf 
#define COPY_SOLN_to_TMPBUF(soln_i)\ 
if((soln_i)< solnCnt)\ 
{\ 

int x;\ 

for(_x= 0; _x< var_CNT; _x++)\ 

tmpsolnBuf[varList_x*(soln_i)+ _x]= *p_VAR_VALUE_in_solnBuf(soln_i, 

_x);\ 

}\ 

} 

// copy the specified (by its from & to-index) solution from tmpsolnBuf into the 

solnBuf 

#define COPY_SOLN_from_TMPBUF(to_soln_x, from_tmp_soln_x)\ 
if ((to_soln_x)< solnCnt && (from_tmp_soln_x)< solnCnt)\ 
{\ 

int x;\ 

for(_x= 0; _x< var_CNT; _x++)\ 

*p_VAR_VALUE_in_solnBuf(to_soln_x,_x)- 
tmpsolnBuf[varList_x*(from_tmp_soln_x)+ x];\ 

}\ 

} 



// misc. static var's 

static int semError = 0; // set to non-zero in case of semantic error. 

static BOOLEAN calledStartProlog4 = FALSE; 

static BOOLEAN startedNewProlog4Session= FALSE; 

static int resultFromProlog4= 0; 

static BOOLEAN fractionalizeRational= FALSE; // if TRUE, fractionalize all rationals 

static BOOLEAN roundoffFractionOnlyRational= TRUE; // if TRUE round-off fraction-only 

rationals (e.g. 2/3); otherwise, return fraction-only rationals as fractions 

static char *p4Argv[3]= {"P4LIB", "-banner=off ' , NULL} ; // init-args to Prolog 

IV 

static BOOLEAN useIntervalSolver= FALSE; 
static char curConstraint[MAX_EXPR_SIZE]; 
static double Precision= DEF_PRECISION; 
static BOOLEAN RandomizeConstraints= FALSE; 

static int SolnDiffWt = DEF_SOLN_DIFF_WT; // weight to indicate how 

"different" the solns must be from each other 
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static long BSeed = 1 ; // seed for the random-bit-generator: brandom() 

static BOOLEAN enumerateVarsRandomlyNoHistory = FALSE; // True if independent vars 

are to be enumerated randomly (without keeping track of their past values) 

static int TimedThreadCount= 0; // keeps a running count of active threads 

static HANDLE TimedSolnMutex; // a semaphore to access TimedThreadCount between 

threads 

static BOOLEAN AbortConstraintTimer= FALSE; // a flag to abort constraint-timer 

static BOOLEAN AbortWatchPrologThread - FALSE; // a flag to abort WatchAbortPrologSoln 

thread 

static char *PrologSolnInterruptFile= NULL; // Presence of this file indicates interruption 
of Prolog-solution 

// misc. static declarations 
static BOOLEAN init_solve_constraint(int keep_solns); 
static TabElem *get_var(char *var); 
static P4TERM get_var_term(char *var); 
static Value *get_term_value(P4TERM term); 
static List *cons(void *elem, List *lst); 
static List *ncons(List *lst, void *elem); 

static P4SYMBOL p4str2symbol(char *str); // pseudo p4-routine 

static P4TERM p4make_atom_from_cstring(char *str); // pseudo p4-routine 

static P4TERM P4Make_Rational(double val); // pseudo p4-routine 

static int p4is_constant(P4TERM term); 

static Value * get_var_value(char *var); 

static P4TERM get_value_term( Value *val); 

static int auxSolveConstraint(char Constraint, int keep_prev_soln, long msec); 

static int h_auxSolveConstraint(char *constraint, int keep_prev_soln, int enum_vars_randomly, 

long msec); 

static P4TERM make_termlist2term(List *lst); 
static P4TERM make_valslist2term(List *lst); 

static P4TERM combine_terms_array(P4TERM terms[], long size_terms, int do_conjunct, int 
randomize, P4TERM var, int var_eq); 

static P4TERM combine_terms_list(List *terms_lst, int do__conjunct, int randomize, P4TERM 
var, int var_eq); 

static int auxSolveConstraintOrdered(char *constraint, int orderjype, int max_soln); 
static double align_val_with_precision(double val, double precision); 
static TabElem *get_term_tabelem(P4TERM term); 
static int getTimedThreadCount(); 

// misc. extern declarations 
extern int yyparse(void); 
extern int yyerror(char *s); 
extern int yylex(void); 



PROLOG SCA -25- 



#ifhdefPRLGHLAPI 

#include "cmn_drvr.c" // driver to test all the stuff out 

#endif /* PRLGHLAPI */ 



// public functions 

char * CCONV GetHLAPIVersion() 

{// return the current version of the Prolog HL API 

return(VERSION); 

} 

BSTR CCONV VBGetHLAPIVersionO // wrapper to GetHLAPIVersion() for VB 
{ 

char *c_ver; 
BSTR vb_ver; 

c_ver= GetHLAPIVersion(); 

vb_ver= SysAllocStringByteLenQSTULL, strlen(c_ver)+l); // alloc a new BSTR 
strcpy((char *)vb_ver, c_ver); 

return(vb_ver); 

} 

DWORD WTNAPI watchAbortPrologSoln(void *null) 

{ // watch AbortPrologSoln- variable or the presence-of-Interrupt-file; if either condition 
becomes true, then abort Prolog constraint-solving-process 
#define SLEEP_INTERVAL (2000) // in msec 

extern int access(); 

for(AbortWatchPrologThread= FALSE; ! AbortWatchPrologThread; 

Sleep(SLEEP_INTERVAL)) // run until someone turns AbortWatchPrologThread to TRUE 
{ 

if (AbortPrologSoln || (PrologSolnlnterruptFile && (access(PrologSolnInterruptFile, 
0)=0))) 

{ 

prolog_events |= (1L« 16); 
} 

} 

Abort WatchPrologThread^ FALSE; // set if FALSE here as an indicator that this thread is 
finished 

return(O); 

} 
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int CCONV SetPrologInterruptFile(char *interrupt_filename) 

{ // set the filename whose presence interrupts Prolog-solution 

PrologSolnInterruptFile= interrupt_filename? strdup(interrupt_filename): NULL; 

return(TRUE); 
} 

static int StartProlog4Session_aux(char *p4hlapilib_file, long heapsize, long choicesize) 

{ // starts Prolog IV, return true (1) if ok, false (0) otherwise. 

// p4hlapilib_file is the pathname to the high-level Prolog IV API library file 
// heapsize is the heap-stack size; choicesize is the choice-stack size. 
// ((argc, argv[]) are arguments to Prolog IV.) 

int status, argc; 

char *p4argv[32]= {"P4LIB", NULL} ; // init-args to Prolog IV 

char *banner_arg= "-banner=off '; 

char heapsize_str[32], choicesize_str[32]; 

P4TERM term; 

long dummy, id; 

if (!(TimedSolnMutex= CreateMutex(NULL, FALSE, NULL))) // create a semaphore to 
access TimedThreadCount 
return(FALSE); 

AbortPrologSoln= FALSE; 

if (!CreateThread(NULL, 0, watchAbortPrologSoln, &dummy, 0, &id)) 
{ 

printf("Unable to create watch-thread\n M ); 
return(FALSE); 

} 

if (!calledStartProlog4) 
{ 

calledStartProlog4 = TRUE; 

p4errno = 0; // reset ProloglV error-no 

// format arguments for the P4 commandline 

argc=l; 

p4argv[argc++]= banner_arg; 
p4argv[argc++]= "-heap"; 
sprintf(heapsize_str, "%d", heapsize); 
p4argv[argc++]= heapsize_str; 
p4argv[argc++]= "-choice"; 
sprintf(choicesize_str, "%d", choicesize); 
p4argv[argc++]= choicesize_str; 

p4argv[argc]= NULL; 
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status= (p4init(argc, p4argv)=0); 
if (! status) 

return(FALSE); 



srandom(time(TSTULL)) ; 

if (p4hlapilib_file && !Compile(p4hlapilib_file)) // load High-level 

ProloglV library 

return(FALSE); 

// set the randomizer-seed in Prolog - from time(NULL) 
p4new_session(); 

term= P4MAKEJOJNC_l ("randomize", p4make_lint(time(NULL))); 

p4make_call(term); 

status = p4next_solution(); 

if (status=P4SESSION_ERROR) 

return (FALSE); 
p4finish_session(); 

#ifdef DO_SETOF_INIT 

// we don't use setof/bagof for now - so, no need to do this initialization 
// initialization to get around a bug in P4 when calling setof/3 or bagof/3 
p4new_session(); 

term= P4AND(P4MAKE_FUNC_2( ,, def_array" J 
p4make_atom_from_cstring( M tab_bagof '), p4make__lint( 1 00)), 

P4AND(P4MAKE_FUNC_2("record", 
p4make_atom_from_cstring("block_limit"), p4make_lint(0)), 

P4MAKE_FUNC_2("record", 
p4make_atom_from_cstring( n last_bag_bound tf ), p4make_lint(0)))); 
p4make_call(term); 
status = p4next_solution(); 
p4finish_session(); 

// end-of-initialization to get around a bug in P4 when calling setof73 or bagof/3 
#endif /* DO_SETOF_INIT */ 

} 

return(TRUE); 
} 

int CCONV StartProlog4Session(char *p4hlapilib_file) 

{ // starts Prolog IV, return true (1) if ok, false (0) otherwise. 

// p4hlapilib_file is the pathname to the high-level Prolog IV API library file 

return(StartProlog4Session_aux(p4hlapilib_file, P4HEAP_SIZE, P4CHOICE_SIZE)); 
} 
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int CCONV StartProlog4SessionSetStacks(char *p4hlapilib_file, long heapsize, long choicesize) 

{ // starts Prolog IV, return true (1) if ok, false (0) otherwise. 

// p4hlapilib_file is the pathname to the high-level Prolog IV API library file 
// heapsize is the heap-stack size; choicesize is the choice-stack size. 

5 retum(StartProlog4Session_aux(p4hlapilib_file,MAX(heapsize,P4HEAP_SIZE)^ 
MAX(choicesize, P4CHOICE_SIZE))); 
} 

int CCONV StartProlog4SessionDefault() 

{ // starts Prolog IV with default parameters, return true (1) if ok, false (0) otherwise. 

1 0 return(StartProlog4Session_aux( n c:\\MyDLL\\HLP41ib.p4", P4HEAP_SIZE, 
P4CHOICE_SIZE)); 
} 

int CCONV EndProlog4Session() 

{ // end Prolog IV session; return true (1) if ok, false (0) otherwise. 
15=, // Abort all the threads: the WatchAbortPrologSoln, and constraint-timer 

Jj{ AbortWatchPrologThread= TRUE; // abort WatchAbortPrologSoln thread 

fn AbortConstraintTimer= TRUE; // Abort all previous constraint-timers 
m while(getTimedThreadCount()> 0) // Sleep until all constraint-timer threads are 
finished/aborted 
Sleep(5); 

while(AbortWatchPrologThread) // Sleep until WatchAbortPrologSoln thread is 
finished/aborted 
Sleep(5); 



it* 



Tf return(TRUE); 
2£ } 



sr. 



static char brandom() 
// return a random-bit (0 or 1) (uses BSeed); 
// uses primitive polynomial modulo 2 (PPM2) of degree 18 

{ 

30 unsigned char newbit; 

newbit = (BSeed» 1 7) & 1 // bit 1 8 

A (BSeed» 4) & 1 
A (BSeed»l)&l 
A (BSeed & 1); 

35 BSeed = (BSeed« 1) | newbit; // shift bits; put newbit at end 

return(newbit); 
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} 

static double align_val_with_precision(double val, double precision) 
// align the given val with the given precision; return the aligned value. 
// (That is, returned-val= N* precision, (where N is integer) such that |returned-val - val| is 
minimum 
{ 

int N; 

if (precision= 0) 
return(val); 

N= (val>= 0)? (int)((val/precision)+0.5): (int)((val/precision)- 0.5); 
val= N* precision; 

return(val); 

} 

// start-of Thread-related functions 
static int incTimedThreadCount() 

{ // increment the TimedThreadCount; (inside a semaphore because of multithreaded 
Hi access.) 

jjl WaitForSingleObject(TimedSolnMutex, INFINITE); 
4: TimedThreadCount++; 
2© ReleaseMutex(TimedSolnMutex); 

^3 return(O); 

u } 

^ static int decTimedThreadCount() 

g { II decrement the TimedThreadCount; (inside a semaphore because of multithreaded 
2%* access.) 
n WaitForSingleObject(TimedSolnMutex, INFINITE); 
TimedThreadCount--; 
ReleaseMutex(TimedSolnMutex); 

return(O); 
30 } 

static int getTimedThreadCount() 

{ // return the current TimedThreadCount; (inside a semaphore because of multithreaded 

access.) 

int cnt; 

WaitForSingleObject(TimedSolnMutex, INFINITE); 
cnt= TimedThreadCount; 
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ReleaseMutex(TimedSolnMutex); 
return(cnt); 

} 

DWORD WINAPI theConstraintTimer(void *p_msec) 
{ 

long msec= *((long *)p_msec); 

// printf("Going to sleep in the timerW); // debug 

if (msec> 0) 

{ 

incTimedThreadCountQ; // increment the active- thread count 
if (msec<= 1000) 

Sleep(msec); 

else 

{ // check AbortConstraimTimer frequently between sleeps 
long t; 

for(t=0; (t< msec) && lAbortConstraintTimer; t+= 1000) 
Sleep(lOOO); 

} 

} 

else 

return(O); 

// printf("Out of sleep in the timer ... setting prolog_events\n"); // - debug 
prolog_events |= (1L« 16); 

decTimedThreadCount(); // decrement the active-thread count 
return(O); 

} 

// end-of Thread-related functions 

static int auxSolveConstraint(char Constraint, int keep_prev_solns, long msec) 

{ // solve the given constraint (e.g. M X= Y+ 4, Y=2."); 

// backtracks over the previous solution if the constraint is empty (i.e. NULL) 

// if keep_prev_solns is true, do not discard the previous solutions 

// if msec> 0, the solver exits in the given max. time (ms) - whether the constraint is 

solved or not 

// return true (=1) [false (=0)] if the constraint is [un] solvable; 

// returns negative integer in error (e.g. if the constraint could not be parsed, or 
solver aborted), 
int stat; 
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long id; 



stat = 0; 

// reset all Prolog flags/events 
resultFromProlog4= 0; 
AbortPrologSoln= FALSE; 
prolog_events= 0; 

if (msec> 0) 

{ // the solution-process must be time-limited 

AbortConstraintTimer= TRUE; // Abort all previous constraint-timers 
while(getTimedThreadCount()> 0) // Sleep until all previous active threads 
finished/aborted 

Sleep(5); 
AbortConstraintTimer= FALSE; 

prolog__events= 0; // reset all previous Prolog events 

if (!CreateThread(NULL, 0, theConstraintTimer, &msec, 0, &id)) 

{ 

printf("Unable to create thread\n"); 
retum(ERR_UNABLE_TO_CRE ATE_THRE AD) ; 

} 

} 

if (constraint) 
{ //a new constraint given 
semError^ 0; 

if (startedNewProlog4Session) // a goal called previously - end that. 
p4finish_session(); 
// initialize all the tables, spaces, counts; 
if ( ! init_solve_constraint(keep__prev_solns)) 

return(ERR_INITI ALIZ ATION) ; 

// start a new Prolog session 

p4new_session(); 

startedNewProlog4Session= TRUE; 

if ((inExprBuf_cnt= strlen(constraint))> MAX_EXPR_SIZE) 
return(ERR_CONSTRAINT_TOO_LONG); 

strep y(inExprBuf, constraint); 
inExprBuf_x= 0; 

stat= yyparse(); 

} 
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else if (calledStartProlog4) // backtrack over the previous result 

{ 

if (semError=0) 

resultFromProlog4= p4next_solution(); 

5 else 

return (FALSE); 

} 

if (p4errno!= 0) 
{ 

10 printf("\n***Unknown error from ProloglV in auxSolveConstraint()***\n"); 

return (ERRPARSE); 
} 

if (semError= 0 && stat= 0) 
return((resultFromProlog4= P4SESSION_SOLUTION)? TRUE: 
1 5 (resultFromProlog4= P4SESSION_END)? FALSE: 

(prolog_events!= 0)? ERR S OLN INTERRUPTED : 
P ERRPROLOGS OL VER) ; 
*0 e l se if (semError!= 0) 
Q1 retum(semError); 
201 else 
4- return(ERR_P ARSE) ; 

I > 

^ static int h_auxSolveConstraint(char *constraint, int keep_prev_solns, int enum_vars_randomly, 
!L long msec) 

2|f { // solve the given constraint (e.g. "X= Y+ 4, Y=2."); using a linear/interval solver as 
needed 

// backtracks over the previous solution if the constraint is empty (i.e. NULL) 
f% II if keep_prev_solns is true, do not discard the previous solutions 

p // if enum_vars__randomly is true, enumerate independent vars randomly, without 

30 keepingtrack of their previous values 

// if msec> 0, the solver exits in the given max. time (ms) - whether the constraint is 
solved or not 

// »(we LOSE track of unique solutions (-cnt) when 

enum_vars_randomly is true.)« 
35 // return true (=1) [false (=0)] if the constraint is [un]solvable; 

// returns negative integer in error (e.g. if the constraint could not be parsed). 

int stat; 

if (constraint) 

{ 

40 if (strlen(constraint)> MAX_EXPR_SIZE) 

return(ERR_CONSTRAJNT_TOO_LONG); 
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strcpy(curConstraint, constraint); 
useIntervalSolver= FALSE; 

enumerateVarsRandomlyNoHistory= enum_vars_randomly; 

if ((stat=auxSolveConstraint(curConstraint, keep_prev_solns, msec))=0 || (stat> 0 && 
!IsFullyConstrained(NULL))) 
{ 

useIntervalSolver= TRUE; 

retum(auxSolveConstraint(curConstraint, keep_prev_solns, msec)); 

} 

return(stat); 

} 

else 

return(auxSolveConstraint(NULL ? keep_prev_solns, msec)); 

} 

int CCONV SolveConstraint(char Constraint) 

{ // solve the given constraint (e.g. "X= Y+ 4, Y=2."); using a linear/interval solver as 
needed 

// backtracks over the previous solution if the constraint is empty (i.e. NULL) 
// return true (=1) [false (=0)] if the constraint is [unjsolvable; 
// returns negative integer in error (e.g. if the constraint could not be parsed). 
return(h_auxSolveConstraint(constraint, FALSE, FALSE, -1)); 



int CCONV SolveConstraintRandomly(char Constraint) 

{ // random-solve the given constraint (e.g. "X= Y+ 4, Y=2."); using a linear/interval solver 
as needed 

// backtracks over the previous solution if the constraint is empty (i.e. NULL) 
// » NO track of unique solutions (-cnt) is kept : You may not get unique 
solutions « 

// return true (=1) [false (=0)] if the constraint is [unjsolvable; 

// returns negative integer in error (e.g. if the constraint could not be parsed). 

return(h_auxSolveConstraint(constraint, FALSE, TRUE, -1)); 

} 

int CCONV TimedSolveConstraint(char Constraint, long msec) 

{ // solve the given constraint (e.g. "X= Y+ 4, Y=2. M ); using a linear/interval solver as 
needed 

// backtracks over the previous solution if the constraint is empty (i.e. NULL) 

// ensures that the call finishes in the given time (ms) - whether the constraint is solved or 

not 

// return true (=1) [false (=0)] if the constraint is [unjsolvable; 

// returns negative integer in error (e.g. if the constraint could not be parsed, or 
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could not be solved in given time). 



retum(h_auxSolveConstraint(constraint, FALSE, FALSE, msec)); 
} 

int CCONV TimedSolveConstraintRandomly(char Constraint, long msec) 

{ // random-solve the given constraint (e.g. "X= Y+ 4, Y=2."); using a linear/interval solver 

as needed 

// backtracks over the previous solution if the constraint is empty (i.e. NULL) 
// » NO track of unique solutions (-cnt) is kept : You may not get unique 
solutions « 

// return true (=1) [false (=0)] if the constraint is [un]solvable; 

// returns negative integer in error (e.g. if the constraint could not be parsed). 

return(h_auxSolveConstraint(constraint, FALSE, TRUE, msec)); 
} 

static int solution_cmp(const Value *vecl, const Value *vec2) 

{ // compare the two solution-vectors; return >,=,< 0 as vecl >,=,< vec2. 

int i, wt, dist; 

double vail, val2; 

for(i= dist= 0; i< varList_x; i++) 

{ 

wt= varListx- i; 

vall= (vecl[i].type= VAL_INTEGER)? vecl[i].value.integer: (vecl[i].type= 
VAL IRRATIONAL)? (vec 1 [i] .value. real.lower.val+vec 1 [i] . value. real.upper.val)/2: 

(vecl[i].type= VAL REAL || vecl[i].type= VALRATIONALFLOAT || 
vecl[i].type= VALRATIONALFRACTION)? vecl[i].value.rational.real: 0; 

val2= (vec2[i].type= VAL INTEGER)? vec2[i]. value, integer: (vec2[i].type= 
VAL_IRRATIONAL)? (vec2[i].value.real.lower.val+vec2[i].value.real.upper.val)/2: 

(vec2[i].type= VAL_REAL || vec2[i].type= VAL RATIONAL FLOAT || 
vec2[i].type= VAL RATIONAL FRACTION)? vec2[i].value.rational.real: 0; 

dist+= (int)(wt*(vall- val2)); // weighted distance 

} 

return(dist); 

} 

static int auxSolveConstraintOrdered(char Constraint, int order_type, int max_soln) 

{ // solve the given constraint (e.g. "X= Y+ 4, Y=2. M ); using a linear/interval solver as 

needed 

// solve to find the given no. (= max_soln) of solutions if max_soln is positive; find 
(nearly) all solutions if it is negative 

// backtracks over the previous solution if the constraint is empty (i.e. NULL) 
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// Store all the solutions in a buffer, order them (by the given order_type)so we can return 
solutions in an ordered fashion 

// present the solutions conforming to the given order (e.g. ORDER_DIFF_TOGETHER) 

// returns, on first call (i.e. when constraint is non-NULL), (1+ 
the_total_count_of_solutions) (> 0) [false (=0)] if the constraint is [un]solvable; 

// (note that in case of constraints without variables (e.g. "4= 4."), 

total-no. -of-solutions is 0, though the constraint is provable.) 

// returns, on subsequent calls (i.e. when constraint is NULL), true (=1) [false (=0)] if a 
solution exists [does not exist]; 

// returns negative integer in error (e.g. if the constraint could not be parsed). 

// (The P4 setof/3 & bagof/3 are buggy - hence we simulate them here ourselves.) 
int i, iy, soln_cnt, half_cnt, stat; 
Value *p_vec, *pval; 
TabElem *p_tab_elem; 
int keep_prev_solns; 
extern void qsort(); 

keep_prev_solns= FALSE; 
RandomizeConstraints= FALSE; 
if (constraint) 
{ 

for(soln_cnt= 0; ((max_soln< 0) || (soln_cnt< max_soln)) && ((stat= 
hauxSolveConstraint(constraint, keepjprevsolns, FALSE,- 1))> 0); ) 

{ 

RandomizeConstraints= (order_type=ORDER_UNIQ_S OLUTIONS) ; // 
randomize (if necessary) var-range-sequences on subsequent calls to solve the constraint 
if (p_vec= NEW_SOLN_VECTOR) 

{ // enough room in the soln-buffer exists — get the solution-vector 

for the variables 

FOR_EACH_VAR(p_tab_elem, i) 

if (pval= get_var_value(p_tab_elem->name)) 

p_vec[i]= *pval; 
END_FOR_EACH_VAR(p_tab_elem, i) 

++soln_cnt; 

SET_BUF_SOLN_CNT(soln_cnt); 
} 

else // too many solutions (or, zero variables in constraint) to store 
break; 

constraint= (order_type=ORDER_UNIQ_SOLUTIONS)? constraint:NULL; 
keep_prev_solns=(order_type=ORDER_UNIQ_SOLUTIONS); 

} 

doBufferSoln= TRUE; 
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if (soln_cnt<= 2) 

return(soln_cnt> 0? soln_cnt+l: (stat> 0)? 1: 0); 

switch(order_type) // ~ order the solutions if so desired — 
{ 

case ORDER_LIKE_TOGETHER: // try to gather like solutions together 
qsort(solnBuf, soln_cnt, sizeof(Value)*varList_x, solution_cmp); 
break; 



shuffle 



case ORDER_RANDOM: // gather solutions in a random sequence - random 

case ORDER_UNIQ_SOLUTIONS: 

for(i= 0, half_cnt= soln_cnt/2; i< half_cnt; i++) 

{ 

iy= half_cnt+ (random()%half_cnt); 

SWAP_SOLUTIONS(i, iy); 

} 

break; 

case ORDER_DIFF_TOGETHER: // try to gather "different" solutions 
together - deterministic shuffle 

if (soln_cnt= 3) 

{ //just swap the last two elements 
SWAP_SOLUTIONS(l, 2); 
return(soln_cnt> 0); 

} 

qsort(solnBuf, soln_cnt, sizeof(Value)*varList_x, solution_cmp); 
for(i= 0, half_cnt= soln_cnt/2; i< half_cnt; i++) // intersperse the ordered 



{ // in preparation for shuffle, store the first half of the soln- vectors 

COPY_SOLN_to_TMPBUF(i); 
} 

for(i= 0, half_cnt= soln_cnt/2; i< half_cnt; i++) // intersperse the ordered 



solutions 
in tmp-buffer 

solutions 

{ // shuffle by mapping first half as: index-> 2*index, and the 
second half as: index ->2*(index- half_cnt)+l. 

MOVE_SOLUTION(2*i+l, i+ haifcnt); 
COPY_SOLN_from_TMPBUF(2*i ? i); 

} 

// after interspersing solutions, add some randomness to it too 
for(i= 0, half_cnt= soln_cnt/2; i< half_cnt; i++) 
{ 

if (brandom()) 

{ 
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iy= half_cnt+ (random()%half_cnt); 

SWAP_SOLUTIONS(i, iy); 

} 

} 

break; 

default: 

break; 

} 

return(soln_cnt> 0? soln_cnt+l: (stat> 0)? 1:0); 

} 

else 

{ 

return(NEXT_BUF_S OLUTION != NULL); 
} 

} 

int CCONV SolveConstraintOrdered(char Constraint, int order_type) 

{ // solve the given constraint (e.g. M X= Y+ 4, Y=2. ,! ); using a linear/interval solver as 

needed 

// backtracks over the previous solution if the constraint is empty (i.e. NULL) 

// present the (nearly) ALL the solutions conforming to the given order (e.g. 
ORDER_DIFF_TOGETHER) 

// returns, on first call (i.e. when constraint is non-NULL), (1+ 
the_total_count_of_solutions) (> 0) [false (=0)] if the constraint is [un]solvable; 

// (note that in case of constraints without variables (e.g. "4= 4."), 

total-no. -of-solutions is 0, though the constraint is provable.) 

// returns, on subsequent calls (i.e. when constraint is NULL), true (= 1) [false (=0)] if a 
solution exists [does not exist]; 

// returns negative integer in error (e.g. if the constraint could not be parsed). 
return(auxSolveConstraintOrdered(constraint, ordertype, -1)); 

} 

int CCONV SolveConstraintOrderedNSolns(char Constraint, int orderjype, int max_soln) 
{ // solve the given constraint (e.g. "X= Y+ 4, Y=2. M ); using a linear/interval solver as 
needed 

// solve to find the given maximum no. (= max_soln) of solutions 

// backtracks over the previous solution if the constraint is empty (i.e. NULL) 

// present the solutions conforming to the given order (e.g. ORDER_DIFF_TOGETHER) 

// returns, on first call (i.e. when constraint is non-NULL), (1+ 

the_total_count_of_solutions) (> 0) [false (=0)] if the constraint is [unjsolvable; 

// (note that in case of constraints without variables (e.g. "4= 4."), 

total-no. -of-solutions is 0, though the constraint is provable.) 

// returns, on subsequent calls (i.e. when constraint is NULL), true (= 1) [false (=0)] if a 
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solution exists [does not exist]; 

// returns negative integer in error (e.g. if the constraint could not be parsed). 
return(aux S o 1 veConstraint Ordered(constraint , orderjyp e, max_so In)) ; 

} 

int CCONV SolveConstraintLin(char *constraint) 

{ // solve the given constraint (e.g. *'X= Y+ 4, Y=2."); using a linear solver only 
// backtracks over the previous solution if the constraint is empty (i.e. NULL) 
// return true (=1) [false (=0)] if the constraint is [un] solvable; 
// returns negative integer in error (e.g. if the constraint could not be parsed). 

useIntervalSolver= FALSE; 

return(auxSolveConstraint(constraint, FALSE, -1)); 

} 

int CCONV SetPrecision(double precision) 

{// set the precision for solving the constraint & for the solutions in the real domain 

//returns TRUE if ok 
if (precision<= 0) 

return(FALSE); 
Precision= precision; 

return(TRUE); 
} 

int CCONV SetSolnDiffWt(int soln_diff_wt) 

{// set the weight to indicate how "different" the solutions must be from each other in 
Uniq_Soln_Order 

// (the higher the weight, the more the solutions are "different".) 

//returns TRUE if ok 
if(soln_diff_wt< 0) 

return(FALSE); 
SolnDiffWt= soln_diff_wt; 

return(TRUE); 
} 

int CCONV FractionalizeRational(int do_fractionalize) 

{ // fractionalize all the rationals if do_fractionalize is TRUE; not otherwise (fractionalization 

may slow things down a bit.) 

fractionalizeRational= do_fractionalize; 

return(TRUE); 

} 

int CCONV RoundoffFractionOnlyRational(int do roundoff) 
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{ // roundoff fraction-only rationals (e.g. 2/3) if do_roundoff is TRUE; otherwise, return 
fraction-only rationals as fractions 
roundoffFractionOnlyRational= do_roundoff; 
return(TRUE); 

} 

int CCONV IsIndependentVar(char *var) 

{ // return TRUE (1) if the given variable is independent (i.e. specified in an enumeration); 
FALSE (0) otherwise 
TabElem *p_tab_elem; 

if (var && (p_tab_elem= get_var(var))) 

return(p_tab_elem->is_independent_var); 

else 

return(FALSE); 

} 

Value * CCONV GetValue(char *var) 

{ // return the ptr to the value (in Value structure) of the given variable (e.g. "Area") if 
known; 

// return NULL on error (e.g. unknown varible, or variabe has no value, ...) 

int i; 

Value *val; 

TabElem *p_tab_elem; 

val= NULL; 

if(ldoBufferSoln) 
{ 

val= get_var_value(var); 

} 

else 

{ // retrieve appropriate value from the soln-buffer 
FOR_EACHVAR(p_tab_elem, i) 

if (!strcmp(var, p_tab_elem->name)) 

{ // found the var in varList 

val= CUR_BUF_SOLUTION(i); 

break; 

} 

END_FOR_EACH_VAR(p_tab_elem, i) 
} 

return(val); 

} 
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long CCONV GetValue_type(Value *val) // return type (e.g. VALINTEGER) of the given 

Value; 

{ 

// returns VAL_UNKNOWN in 

error 

return(val? val->type: VAL UNKNOWN); 
} 

long CCONV GetVarValue_type(char *var) // return type (e.g. VAL INTEGER) of the given 

variable; 

{ 

// returns VALJJNKNOWN in 

error 

Value *val; 

return ((val= GetValue(var))? val->type: VAL UNKNOWN); 

} 

long CCONV GetValue_int(Value * val) // return integer value of the given Value structure; 
{ // return 

ERR_GETVALUEINT in error (e.g. given structure is not integer) 

return((val && val->type= V AL_INTEGER) ? val->value.integer: ERRGET V ALUEINT) ; 
} 

Rational CCONV GetValue_rational(Value *val) // return rational value of the given Value 
structure; 

{ // return <ERR_GETVALUE_RAT, 

ERR GETVALUEJNT, ERR_GETVALUE_rNT> in error (e.g. given structure is not rational) 

Rational rat; 

if (val && val->type= VALRATIONALFLOAT || val && val->type= 
VAL_RATIONAL_FRACTION) 

return(val->value.rational); 
else 

{ 

rat.real= ERRGET V ALUERAT ; 
rat.num = rat.den = ERR_GET VALUE INT; 
return(rat); 
} 

} 

double CCONV GetValue_rational_float(Value *val) // return float rep. of the given 

rational Value 

{ 

return((val && (val->type== VAL RATIONAL FLOAT || val->type= 
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V AL_RATIONAL_FRACTION))? val->value.rational.real: ERR_GET V ALUE_RAT) ; 
} 

long CCONV GetValue_rational_numer(Value *val) 

{ // return numerator of the fractional rep. of the given rational Value 

return((val && val->type= VAL_RATIONAL_FRACTION)? val->value.rational.num: 0); 

} 

long CCONV GetValue_rational_denom(Value *val) 

{ // return denominator of the fractional rep. of the given rational Value 

return((val && val->type= VAL_RATIONAL_FRACTION)? val->value.rational.den: 0); 

} 

Real CCONV GetValue_real(Value *val) // return real value (i.e. lower & upper bound) from 
the given non-rational Value structure; 

{ // return <1, 0> in error (e.g. given structure is not 

real) 

Real rl; 

if (val && val->type== VALJRRATIONAL) 

return(val->value.real) ; 
else 

{ // error 

rl.lower.val= 1; 

rl.upper.val= 0; 

rl.lower.is - infinite= rl.upper.is_infinite= TRUE; 
return(rl); 

} 

double CCONV GetValue_real_lower(Value *val) // return lower bound for the given 
non-rational real value 

{ // return ERRGETVALUEREAL in error 

return(val && val->type= VALJRRATIONAL? 

(val->value.real.lower.is_infinite?ERR_GETVALUE_REAL: 
val->value.real.lower. val) : ERR_GET V ALUE_RE AL) ; 
} 

double CCONV GetValue_real_upper(Value *val) // return upper bound for the given 
non-rational real value 

{ // return ERR GETVALUE REAL in error 

return(val && val->type= VALJRRATIONAL? 

(val->value.real.lower.isJnfinite?ERR_GETVALUE_REAL: 
val->value.real.upper.val):ERR_GETVALUE_REAL); 

} 
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BSTR CCONV VBGetValue_string(Value *val) // VB wrapper for GetValuestringO 
{ 

char *c_val; 
BSTR vb_val; 

if(!val) 

return (NULL); 
vb_val= NULL; 

if (c_val= GetValue_string(val)) 
{ 

vb_val= SysAllocStringByteLen(NULL, strlen(c_val)+l); // alloc a new BSTR 

strcpy((char *)vb_val, c val); 
} 

return(vb_val); 

} 

1 5 BSTR CCONV VBGetVarValue(char *var) // VB wrapper for GetVarValue() 

-* char *c_val; 
|j BSTR vb_val; 

ji if(!var) 

2^ return (NULL); 

vb_val= NULL; 
if (c_val= GetVarValue(var)) 
{ 

d vb_val= SysAllocStringByteLen(NULL, strlen(c_val)+l); // alloc a new BSTR 

l£l strcpy((char *)vb_val, c_val); 

y return(vb_val); 
o } 

char * CCONV GetVarValue(char *var) // return (uniform) string representation of 

30 the given variable 

{ // returns NULL in error 

Value *val; 

if(!var) 

return (NULL); 

return ((val= GetValue(var))? GetValue_string(val): NULL); 
} 



■ 5 s * 
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int CCONV GetVarValueBuf(char *var, int valuebufjen, char valuebuf[]) // 

return (uniform) string representation of the given variable in the value-buffer 

{ // returns length (>0) of 

the value in the valuebuf; returns <= 0 in error 

Value *val; 

char *val_str; 

int val_len; 

if (!var || ! valuebuf || valuebuf_len<= 0) 

return (-1); 
if (valuebuf_len> 0) 

valuebuf[0]= 0; 
val_str= (val= GetValue(var))? GetValue_string(val): NULL; 
val_len= val_str? strlen(val_str): 0; 
if ((val_len> 0) && (valuebuf_len> valjen)) 

{ 

strcpy(valuebuf, val str); 
free(val_str); 

}- 

else 

return (-1); 
return (val_len); 

} 

char * CCONV GetValue_string(Value *val) // return (uniform) string representation of 

the given Value structure 

{ // return NULL in error (e.g. given structure is not valid) 
char str[1024], *p_tmp; 
List *lst; 

if(!val) 

return(NULL); 
switch(val->type) 

{ 

case VALINTEGER: 

sprintf(str, "%ld", val->value.integer); 
break; 

case V ALRATION ALFLO AT : 

sprintf(str, "%f ', val->value.rational.real); 
break; 

case VALRATIONALFRACTION: 
if (val->value.rational.den != 1) 
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sprintf(str, "%d/%d'\ val->value.rationalnum 5 val->value.rational.den); 
else 

sprintf(str, "%d M , val->value.rational.num); 
break; 

case VALJRRATIONAL: 

if (val->value.real.lower.is_infinite) 

sprintf(str, "(<-, "); 
else 

sprintf(str, "(%f, val->value.real.lower.val); 
if (val->value.real.upper.is_infinite) 

sprintf(str+strlen(str), "">) n ); 
else 

sprintf(str+strlen(str), "%f)", val->value.real.upper.val); 
break; 

case VAL_VAR: 

strcpy(str, "_"); 
break; 

case VAL STRING: 

strcpy(str 5 val->value.string); 
break; 

case VAL_FUNCTOR: 

sprintf(str, ,f %s/%d", val->value.functor.predicate, val-> value. functor. arity); 
break; 

case VAL_LIST: 

strcpy(str ? "["); 

for(lst= val->value.list; 1st; lst= lst->next) 

{ 

if (p_tmp= GetValue_string((V alue *)lst->elem)) ' 
strcat(str, p_tmp); 

if (lst->next) 

strcat(str, ", "); 

} 

strcat(str, "]"); 
break; 

default: 

retum(NULL); 

} 

return(strdup(str)) ; 
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} 

int CCONV IsFullyConstrained(char *constraint) 

{ // returns TRUE if the given constraint is fully constrained (i.e. solvable & all variables are 
constant); FALSE otherwise (or in error) 

// (Check the immediately previous constraint if the given constraint is NULL.) 

// Note: It works only for the linear constraints because we use the linear-solver only here. 
// As such, it labels nonlinear constraints such as: Y A 2= 2. as 

unconstrained. 

// The trouble with using interval-solver is that it may take a long 

time 

// to solve unconstrained equations e.g. X= Y+ 2. (because it finds 

all the solutions at once.) 
int i; 

Value *pval; 
TabElem *p_tab_elem; 

if (! constraint || SolveConstraintLin(constraint)> 0) 
{ 

FOR_EACH_VAR(p_tab_elem, i) 

if (pval= doBufferSoln? CUR_BUF_SOLUTION(i): get_term_value(pjab_elem->term)) 
{ // ?? should we use get_var_value() here instead of get_term_value() ??? 

if (pval->type== VAL VAR || 

(pval->type= VALJRRATIONAL && 

(pval->value.real.lower.is_infinite || pval->value.real.upper.is_infmite && 
ABS(pval->value.real.upper.val- pval->value.real.lower.val)> 
p_tab_elem->precision))) 
break; 

} 

END_FOR_EACH_VAR(p_tab_elem, i) 
return(i>= var_CNT); // true if all var's are constant 

} 

else 

return(FALSE); 

} 

BSTR CCONV VBPrintAllVarVals() // VB wrapper (almost) for PrintAllVarVals() 

{ 

char *c_val, buf[1024]; 
BSTR vb_val; 

vb_val=NULL; 

if (c_val= PrintAllVarVals(buf)) 
{ 

vb_val= SysAllocStringByteLen(NULL, strlen(c_val)+l); // alloc a new BSTR 
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strcpy((char *)vb_val, c_val); 

} 

return(vb_val); 
} 

char * CCONV PrintAllVarVals(char buf[]) 

{ // Print all the var's with their values in the given buffer; return ptr to the given buffer 
// (assumes buffer is large enough to store all the var's.) 
int i; 

TabElem *p_tab_elem; 
char tmp[256]; 

if(!buf) 
return(NULL); 
buf[0]= 0; 

FOR_EACH_VAR(p_tab_elem, i) 

sprintf(tmp, "%s: %s, p_tab_elem->name, GetValue_string(GetValue(p_tab_elem->name))); 

strcat(buf, tap); 
END_FOR_EACH_VAR(p_tab_elem, i) 
if(strlen(buf)>= 2) 

buf[strlen(buf)-2]= 0; // remove the last comma 

return(buf); 

} 

char * CCONV PrintAllVarValsAllocate() 

{ // Print all the var's with their values in an allocated buffer; return ptr to the given buffer 
charbuf[2048]; 

PrintAllVarVals(buf); 

return(strdup(buf)); 
} 

int CCONV Compile(char *p4_filename) // compile & load the given p4_filename 
(containing Prolog IV program) 

{ // return true (1) if the file compiled ok, false (0) in error 
int stat; 

p4new_session(); 

p4make_call(P4MAKE_FUNC_l( M compile", p4make_atom_from_cstring(p4_filename))); 

stat= (p4next_solution()= P4SESSION_SOLUTION); 

p4fmish_session(); 
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return(stat); 

} 



static int term_numden(P4TERM term, int *num, int *den) 

{ // performs fractional representation for the given rational term i.e. rational= num/den (e.g. 4.5 
9/2) 

// uses numden/3 to achieve that, (note that you can call a Prolog predicate in the middle of 
another - in a recursive fashion.) 

// puts the numerator in the given num, and denominator in den. 
// returns TRUE if succeeded in doing the transformation, FALSE otherwise, 
int stat; 

P4TERM tnum, tden; 

if (! term) 

return(FALSE); 
*num= *den= 0; 

p4new_session(); // note that we start a session before making new terms - these new terms are 

valid only for this session 

tnum= check_term(p4make_var()); 

tden= check_term(p4make_var()); 

p4make__call(P4MAKE_FUNC_3( M numden" ? term, tnum, tden)); 

if ((stat= (p4next_solution()= P4SESSION_SOLUTION)) && p4is_integer(tnum) && 

p4is_integer(tden)) 

{ 

*num= p4val_lint(tnum); 
*den r = p4val_lint(tden); 

} 

p4fmish_session() ; 
return(stat); 

} 

static int numden(double rational, int *num, int *den) 

{ // performs fractional representation for the given rational number i.e. rational= num/den (e.g. 
4.5= 9/2) 

// uses numden/3 to achieve that, (note that you can call a Prolog predicate in the middle of 
another - in a recursive fashion.) 

// puts the numerator in the given num, and denominator in den. 

// returns TRUE if succeeded in doing the transformation, FALSE otherwise. 

reUim(teirn_numden(check_term(P4Make_Rational(rational)) 5 num, den)); 

} 
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static int gcd(int x, int y) 

{ // return the GCD of the two given integers 

int num, den, tmp; 

if(x<y) 
{ // swap x & y 
tmp= x; 

x= y; 
y=x; 

} 

if (x= 0 || y— 0 || x=l || y=l) 

return(l); 
if(x=y||x=(-y)) 

return(x); 

if (numden(((double)x)/y, &num, &den)) 
return((int)(x/num)); 
else 

return(l); 

} 

// private functions 

int GetInString(char buf[], int max_size) // used in lexer - make it static later 

{ // put input string (upto max_size) in the given buf[]; (usually called by YY_INPUT from 

lexical analyzer) 

// return the no. of char's actually put in buf[]. (returns 0 if no char's put.) 
int out_cnt; 

out_cnt= MIN(max_size, (inExprBuf_cnt- inExprBuf_x)); // max. no. of char's to put in buf[] 
memcpy(buf, inExprBuf+inExprBuf_x, out_cnt); 
inExprBuf_x += out_cnt; 

return(out_cnt); 

} 

static int bounds_of_real_var(P4TERM var, Real *realp) 

{ // find the lower & upper bounds of the given (numeric) (real) var; 

// return true (1) on success; false (0) on failure (e.g. given var is not numeric) 
// (much of this fiinc suggested by Pascal Bouvier of Prologianet) 
// (we use glb/2 & lub/2 instead of bounds/3 so we can assign the 
// infinite-bound to the appropriate end (i.e. lower/upper)) 

P4TERM tA, tB; 

int done, status; 
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done= FALSE; 

realp->lower.is_infinite= realp->upper.is_infinite= FALSE; 
realp->lower.val= realp->upper.val= 0; 

// well, for efficiency, let's use bounds/3 to check if the var is unbounded on either side 
p4new_session(); 
tA = p4make_var(); 
tB = p4make_var(); 

p4make_call(P4MAKE_FUNC_3("bounds", var, tA, tB)); 
if ((status= p4next_solution())!= P4SESSION_SOLUTION) 

{ 

if (status != P4SESSIONERROR) 

realp->lower.is_infmite= realp->upper.is_infinite= TRUE; // «-- KNJ: This is 
not strictly correct, REVISIT it later -» 
else 

{printf("\n***Encountered error 1 in 
bounds_of_real_var()* * *\n n );fflush(stdout); } 
done= TRUE; 

} " 

p4finish_session() ; 
if (done) 

return(TRUE); 

// first, check if the given var. is really unbounded on the lower side 
p4new_session(); 

p4make_call(P4MAKE_FUNC_2("lt", var, P4Make_Rational(DEF_LOWER_BOUND))); 
if ((status= p4next_solution())= P4SESSION_SOLUTION) 

{ 

realp->lower.is_infmite= TRUE; 

} 

else 

{ // not unbounded on the lower side - find the actual lower bound 
if (status= P4SESSION_ERROR) 

{printf("\n***Encountered error 2 in 
bounds_of_real_var()***\n f, );fflush(stdout);} 

p4finish_session(); 
p4new_session(); 
tA = p4make_var(); 

p4make_call(P4MAKE_FUNC_2( n glb", var, tA)); // get the lower bound 
switch(p4next_solution()) 

{ 

case P4SESSION_END: realp->lower.is_infinite= TRUE; break; // 
solution - the bound is infinite 

case P4SESSIONSOLUTION: realp->lower.val= p4val_rational(tA); 
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realp->lower.is_infinite= 

SAME(realp->lower.val, DEFLOWERB OUND) || 



(realp->lower.val< 



DEFLOWERBOUND); 



break; 

case P4SESSION_ERROR: // error - given var may be 

non-numeric 

default: return(FALSE); 
10 } 
} 

p4finish_session(); 

// next, check if the given var. is really unbounded on the upper side 
p4new_session(); 

p4make_call(P4MAKE_FUNC_2("gt", var, P4Make_Rational(DEF_UPPER_BOUND))); 
if ((status= p4next_solution())= P4SESSION_SOLUTION) 

{ 

realp->upper.is_infinite= TRUE; 

S > 

2S5 else 

yi { // not unbounded on the upper side - find the actual upper bound 

J if (status= P4SESSIONJERROR) 

J3 {printf("\n***Encountered error 3 in 

4 » bounds_o f_real_var() * * *\n H ) ; fflush(stdout) ; } 

25 ^ p4finish_session(); 
y p4new_session(); 
zi' t A = p4make_var() ; 

p4make_call(P4MAKE_FUNC_2("lub M 5 var, tA)); // get the upper bound 
switch(p4next_solution()) 

3g { 

case P4SESSION_END: realp->upper.is_infinite= TRUE; break; // no 

solution - the bound is infinite 

case P4SESSION_SOLUTION: realp->upper.val= p4val_rational(tA); 

realp->upper.is_infmite= 

35 SAME(realp->upper.val 3 DEF_UPPER_BOUND) || 

(realp->lower.val> 

DEF_UPPER_BOUND); 

break; 

40 case P4SESSION_ERROR: // error - given var may be 

non-numeric 

default: return(FALSE); 
} 
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} 

p4finish_session() ; 



return(TRUE); 
} 

static P4TERM get_value_term(Value *val) 

{ // return the Prolog IV term for the given basic value (in Value struct) 
if(!val) 
return(NULL); 
switch(val->type) 

{ 

case VAL_INTEGER: retum(check_term(p4make_lint(val->value. integer))); break; 
case V AL_RATIONAL_FLO AT : 
retum(check_term(P4Make_Rational(val->value.rational.real))); break; 
case VAL_RATIONAL_FRACTION: 

return(((val->value.rationalden !- 1) && (val->value.rational.den != 0))? 

check _teim(P4Make_Rational((double)val->valueTational.num/(double)val->value.rationaLd 
): 

check_term(P4Make_Rational((double)val->value.rational.num))); 
break; 

case VAL_IRRATIONAL: // 11 what is the P4-call to make a P4term for an irrational 

111 

return(NULL); break; 
case VAL_VAR: return(NULL); break; 
case VAL_STRING: 
retum(checkJerm(p4make_atom_from_cstring(val->value.string))); break; 

case VAL_FUNCTOR: // 11 what is the P4-call to make a P4term for a functor 111 
return(NULL); break; 
case VAL_LIST: return(check_term(make_valslist2term(val->value.list))); break; 

default: return(NULL); 
} 

return(NULL); 
} 

static Value * get_var_value(char *var) 

{ // return the (ptr to) value (in Value struct) of the given ProloglV variable 
// (It finds the basic value through get_term_value(), and 

// then interprets that further for the given var & its type (e.g. precision/type considerations) 

) 

TabElem *p_tab_elem; 
Value *val; 
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if (!var) 

return(NULL); 

if (!(p_tab_elem= get_var(var)) || !(val= get_term_value((P4TERM)p_tab_elem->term))) 

{ 

if(!val) 

{printf("\n***Recvd NULL value for the given variable %s;***\n", 
var) ; fflush(stdout) ; } 
retum(NULL); 

} 

switch(val->type) 
{ 

case VAL_VAR: 

/* «-- KNJ: ignore all this for now - for efficiency's sake ~ REVISIT it later 

-» 

if (uselntervalSolver && bounds_of_real_var((P4TERM)p_tab_elem->term, 
&val-> value. real)) 
{ 

val->type= VALJRRATIONAL; 

if (!val->value.real.lower.is_infinite && 

!val->value.real.upper.is_infmite && 
ABS(val->value.reaLupper.val- val->value.real.lower.val)<= 
p_tab_elem->precision) 

{ // the range is smaller than the variable's precision - it can be represented 

as a rational 

val->type= VAL_RATIONAL_FLOAT; 
val->value.rational.real= (val->value.real. lower. val+ 
val->value.real.upper.val)/2; 

val->value.rational.num= val->value.rational.den= 0; 
if (p_tab_elem->type= V AL_RATIONAL_FRACTION) 
{ 

numden(val->value.rational.real, &val->value.rational.num, 

&val->value.rational.den); 

val->type= VALRATIONALFRACTION; 

} 

} 

} 

*/ 

break; 

case VALJRRATIONAL: 
#ifdef OLDIRRATIONAL 

if (!val->value.real.lower.is_infinite && 

!val->value.real.upper.is_infinite && 
ABS(val->value.real.upper.val- val->value.real. lower. val)<= 
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p_tab_elem->precision) 

{ // the range is smaller than the variable's precision - it can be represented as a rational 
// this introduces errors (due to roundoff) which, however small, are 
unacceptable for ETS work 

val->type= VAL_RATIONAL_FLOAT; 

val->value.rational.real= align_val_with_precision((val->value. real, lower. val+ 
val->value.real.upper.val)/2, p_tab_elem->precision); 

val->value.rational.num= val->value.rational.den= 0; 

if (pjab_elem->type= VAL_RATIONAL_FRACTION) 

{ 

numden(val->value.rational.real, &val->value.rational.num, 
&val->value.rational.den); 

val->type= VALRATIONALFRACTION; 

} 

} 

#endif /* OLD IRRATIONAL */ 
break; 

case V ALRATION ALFLO AT : 

val->value.rational.real= align_val_with_precision(val->value.rational.real, 
p_tab_elem->precision); 

if (p_tab_elem->type= VAL RATIONAL_FRACTION) 

{ 

numden(val->value.rational.real, &val->value.rational.num, &val->value.rational.den); 
val->type= VALRATIONALFRACTION; 

} 

break; 

default: 

break; 

} 

return(val); 
} 

static int are_equal_terms(P4TERM terml , P4TERM term2) 
{ // returns true if the two given terms are equal 
int stat; 

if (Iterml || !term2) 

return(FALSE); 

p4new_session(); 

p4make_call(P4EQ(terml, term2)); 

stat= (p4next_solution()= P4SESSION_SOLUTION); 
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p4finish_session(); 

return(stat); 

} 

static Value *get_term_value(P4TERM term) 

{ // return the basic value (in Value struct) of the given Prolog IV term 
Value *val, *p_tmp_val; 
int term_type; 

if (!term || p4is_nil(term)) 
retum(NULL); 

//val= (Value *)calloc(l, sizeof(Value)); 
val= NEW_VALUE; 
switch(term_type= P4WHAT_IS(term)) 

{ 

case P4INTEGER: 

val->type= VAL_INTEGER; 
val->value.integer= p4val_lint(term); 
break; 

case P4FLOAT: 

val->type- VAL_RATIONAL_FLOAT; 
val->value.rational.real= p4val_double(term); 
val->value.rational.num= val->value.rational.den= 0; 
break; 

case P4RATIONAL: 

val->type= VAL_RATIONAL_FLOAT; 
val->value.rational.real- p4val_rational(term); 
if (IroundoffFractionOnlyRational && !are_equal_terms(term ; 
check_term(P4Make_Rational(val->value.rational.real)))) 

{ // if the rational cannot be represented in non- fractional terms 
val->type= VAL_RATIONAL_FRACTION; 

term_numden(term, &val->value.rational.num, &val->value.rational.den); 

} 

break; 

case P4ATOM: 

val->type= VAL_STRING; 

val->value.string= p4val_cstring(term); // do we need to realloc the string ? 
break; 

caseP4DOT: 
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0 • 

val->type= VAL_LIST; 

p_tmp_val= get_term_value(p4cdr(term)) ; 

val->value.list= cons(get_term_value(p4car(term)) 5 p_tmp_val? p_tmp_val->value.list: 
NULL); 

break; 

case P4FUNCT0R: 

val->type= VAL_FUNCTOR; 
val->value.functor.predicate= p4val_cstring(term); 
val->value.functor.arity= p4get_arity(term); 
break; 

case P4VAR: 

val->type= VAL_VAR; 

if (bounds_of_real_var(term, &val->value.real) && // «-- added check: KNJ 
!val->value.real.lower.is_infmite && !val->value.real.upper.is_infinite) 
val->type= VALJRRATIONAL; 
break; 

default: 

printf("\n***Recvd unknown value-type for the given variable;* **\n"); 

fflush(stdout); 

//free(val); 

return(NULL); 

} 

if (p4errno!=0) 

{printf("\n***Unknown error occurred when getting value of a 
variable;***\n ,? );fflush(stdout);} 

return(val); 

} 

// aux functions 
static int hash(char *str) 

{ 

int i, h; 

for(i= h= 0; str[i]; i++) h += str[i]*i; 

return(h% VAR_TABLE_SIZE); 

} 

static TabElem *get_var(char *var) 

{ // ptr to the appropriate variable-entry in the var-table 
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TabElem *p; 

for(p= varTable[hash(var)]; p && p->name && strncmp(p->name, 

MAX_VAR_NAME_LEN); p= p->next); 

return(p); 

} 

static P4TERM get_var_term(char *var) 

{ // return the term associated with the variable 

TabElem *p; 

p= get_var(var); 

return(p? (P4TERM)p->term: NULL); 

} 

static TabElem *get_term_tabelem(P4TERM term) 

{ // return the var-table-element associated with the given term 

int i; 

TabElem *p_tab_elem; 

FOR_EACH_VAR(p_tab_elem, i) 
if (p_tab_elem->term= term) 

return(p_tab_elem) ; 
END_FOR_EACH_VAR(p_tab_elem, i) 

return(NULL); 

} 

static int set_term_on_grid(P4TERM term) 

{ 

TabElem *p_tab_elem; 
if (p_tab_elem= get_term_tabelem(term)) 
p_tab_elem->ongrid= TRUE; 

return TRUE; 

} 

static int reset_term_on_grid(P4TERM term) 

{ 

TabElem *p_tab_elem; 
if (p_tab_elem= get_term_tabelem(term)) 
p_tab_elem->ongrid= FALSE; 

return TRUE; 

} 
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static void insert_const(P4TERM term, Value *const_value) 
{ // insert the given {term, constant value} pair in constBuf[] 
ADD_constBuf(term, *const_value); 
return; 
5 } 

static Value *get_const_value(P4TERM term) 

{ // return the Value associated with the given term if the term is numeric-constant; NULL 

otherwise. 

int i; 

10 for(i= 0; (i< constBuf_x) && (constBuf[i].term != term); i++); 
return((i< constBuf_x)? &constBuf[i] .value: NULL); 

} 

static P4TERM insert_var(char *var) 

{ // insert given var (with an associated Prolog term) to the var-table if not already present 
15 // return ptr to the term associated with the var. 

TabElem *p; 
int h; 
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if(!strcmp(var, M _")) 
lj { // anonymous variable - just return a Term for it 
2ffi return(check_term(p4make_var())); 

=| } 

4 3 else if ( ! (p= get_var(var))) 

b { // non-anonymous variable - store in variable table 

Cj p= NEW_TAB JELEM; 
2|f // initialize variable to default type 

H p->type= DEF_V AR T YPE ; // <-- actual type (e.g. int, ...) may be put later 

p->is_independent_var = FALSE; 
5j p->precision= DEF_PRECISION; 
U p->ongrid= DEF_GRID; 
30 strncpy(p->name, var, M AX_V AR_N AME_LEN) ; 
p->term~ check_term(p4make_var()); 
p->next= varTable[h= hash(var)]; 
varTable[h]= p; 
ADD_varList(p); 
35 } 

return((P4TERM)p->term); 

} 

static P4TERM insert_var_with_precision(char *var, double precision) 

{ // insert (or modify its attribs if preexistent) given var (with an associated Prolog term) to the 
40 var-table; 
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// (attach the given precision to the variable) 

// return ptr to the term associated with the var. 
TabElem *p; 
int h; 

if (! (p= get_var(var))) 

{ 

p= NEW_TAB_ELEM; 

// initialize variable to default type 
p->type= DEF_VAR_TYPE; // <-- actual type (e.g. int, ...) may be put later 

p->is_independent_var = FALSE; 
p->ongrid= DEFGRID; 

stracpy(p->name, var, MAX_VAR_NAME_LEN); 

p->term= check_term(p4make_var()); 

p->next= varTable[h= hash(var)]; 

varTable[h]= p; 

ADD_varList(p); 

} 

p->precision= precision; 

return((P4TERM)p->term); 
} 

static int mark_var_type(char *var, int type) 

{ // mark the type of the given variable; return TRUE if ok, FALSE in error 
TabElem *p; 

if (!(p= get_var(var))) 

return(FALSE); 
p->type= type; 

return(TRUE); 
} 

static int mark_term_var_type(P4TERM term, int type) 

// mark the type of the given term (in the var-table) as given; 

// returns TRUE if the action done successfully; FALSE otherwise. 

{ 

TabElem *p_tab_elem; 

if (p_tab_elem= get_term_tabelem(term)) 

{ 

p_tab_elem->type= type; 
return(TRUE); 
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} 

else 

return(FALSE); 

} 

static int mark_term_list_type(List *var_lst, int type) 

{ // mark the type of the variables in the given variable-term-list; return TRUE if ok, 
FALSE in error 

for( ; var_lst; var_lst= var_lst->next) 
mark_term_var_type((char *)var_lst->elem, type); 

return(TRUE); 
} 

static List *cons(void *elem, List *lst) 

{ // cons the given elem to the [front of the] list 

List *p; 

if (! elem) 
return(lst); 

if (p= calloc(l, sizeof(List))) 

{ 

p->elem= elem; 
p->next= 1st; 

p->elem_cnt= 1st? lst->elem_cnt+l: 1; 

} 

else 

{ 

printf("\n***Unable to calloc List in cons()***\n");fflush(stdout); 
return(NULL); 
} 

return(p); 

} 

static List *ncons(List *lst, void *elem) 

{ // neons the given elem to the [end of the] list 

List *p, *1; 

if (!elem) 
return(lst); 
if (p= calloc(l, sizeof(List))) 

{ 

p->elem= elem; 
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p->next= NULL; 
p->elem_cnt= 1 ; 

else 

{ 

printf("\n***Unable to calloc List in ncons()***V');fflush(stdout); 
return(NULL); 
} 

if (1st) 
{ 

lst->elem_cnt-Hh; 

for(l= 1st; l->next; 1= l->next); 

l->next= p; 

> 

else 
lst= p; 

return(lst); 

} 



// — action-routines — 

static int fmd_setof_soln(P4TERM goal) 
{ // find (& buffer & reorder) the set of solns for the given goal; 
// return the Prolog-returned status of the call 

// Note that the P4 must have been initialized with the following query once before calling 
setof/3 or bagof73: 

// def_array(tab_bagof, 100), record(block_limit, 0), record(last_bag_bound, 0). 
int i, soln_cnt, status; 
P4TERM var_set, R, vec; 
Value *p_vec; 

if(ldoBufferSoln) 
return(FALSE); 

for(var_set= check_term(p4make_nil()), i= varList_x-l ; i>= 0; i-) // build a term for the set of 
var's 

var_set= check_term(p4make_dot((P4TERM) varList[i]->term, var_set)); 
R= check_term(p4make_var()); 
goal= P4MAKE_FUNC_3("setof var_set, goal, R); 
P4M AKE_C ALL(goal) ; 

if ((status= (p4next_solution()=P4SESSION_SOLUTION)) && !p4is_nil(R)) 
{ // found the solns - buffer them 
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for(soln_cnt= 0; !p4is_nil(R); R= p4cdr(R)) 

{ 

if (p_vec= NEW_SOLN_VECTOR) 
{ // enough room in the soln-buffer exists 
for(vec= p4car(R), i= 0; !p4is_nil(vec); vec= p4cdr(vec), i++) 

{ 

p_vec [i]= * get__term_value(p4car(vec)) ; 

} 

soln_cnt++; 

} 

} 

SET_BUF_SOLN_CNT(soln_cnt); 

//**** how about ordering the solutions in next pass 

} 

return(status); 

} 

static P4TERM split_var_range_term() 

{ // return the split-var-range term (e.g. intsplit([X, Y]), realsplit([Z])) for the var f s in the current 
constraint 

// (useful only while solving with the interval solver.) 
// (we set the default var-type to be real.) 

// NOTE: if the variable is UNBOUND in the clause, a split (intsplit/realsplit) 
// may give rise to VB overflow ! ! 

int i; 

P4TERM lst_term, term, intsplit, realsplit; 
//P4TERM anon; 
TabElem *p_tab_elem; 

if (luselntervalSolver) // can we use intsplit/realsplit outside of the interval-solver 

?NO 
return(NULL); 

intsplit= realsplit= NULL; 
FOR_EACH_VAR(pJab_elem, i) 
switch(p_tab_elem->type) 
{ 

case VAL_INTEGER: 

lst_term= check J;erm(p4make_dot(p_tab_elem->term, p4make_nil())); // X -> [X] 

term= P4MAKE_FUNC_3("intsplit", 1st Jerm, 
check_term(p4make_atom_from_cstring("smallest_domain ,f )), 
check_term(P4Make_Rational(p_tab_elem->precision))); 

intsplit= P4AND(intsplit, term); 

break; 
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case V AL_RATIONAL_FLO AT : 
case VALJRATIONALJFRACTION: 
case VALJRRATIONAL: 
case VALREAL: 

lst_term= check_term(p4make_dot(p_tab_elem->term, p4make_nil())); // X -> [X] 

term= P4MAKE_FUNC_3 ("realsplit", lstjerm, 
checkJerm(p4make_atom_from_cstring( M smallest_domain M )) 5 
check_term(P4Make_Rational(p_tab_elem->precision))); 

realsplit= P4AND(realsplit, term); 

break; 

case VAL_LIST: 
case VAL_SYMBOL: 
break; 

default: 
break; 

} 

END_FOR_EACH_VAR(p_tab_elem, i) 

// « — how does it work in case the anon var. is nonnumber e.g. list ?? 
// NOTE: if the variable is UNBOUND in the clause, a split (intsplit/realsplit) may give 
rise to VB overflow ! ! 

#ifdef NOIGNOREANONSPLIT // don't do it until really needed 

FOR_EACH_ANON_VAR(anon) 

lst_term= p4make_dot(anon, p4make_nil()); // X -> [X] 

term= P4MAKE_FUNC_3("realsplit", lstjerm, 
p4make_atom_from_cstring("smallest_domain")); 

realsplit= realsplit? P4AND(realsplit, term): term; 
END_FOR_EACH_ANON_VAR(anon) 
#endif /* NOIGNORE ANON SPLIT */ 

return(P4AND(intsplit, realsplit)); 
} 

static P4TERM set_var_bounds_term() 

{ // return the term setting bounds (e.g. -BOUND < X < BOUND) for all the variables used in the 
constraint 
// (useful only for the interval solver.) 

// (ideally, we should first check to see if the var has a bound already set in the constraint. 
// only when no such bound is set should we set a default one. 
int i; 

P4TERM term, bound; 
//P4TERM anon; 
TabElem *p_tab_elem; 
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if (luselntervalSolver) 
retum(NULL); 

term= NULL; 

FOR_EACH_VAR(p_tab_elem, i) 

if (p_tab_elem->type= VAL INTEGER || p_tab_elem->type= VALREAL || 

p_tab_elem->type= VAL_RATIONAL_FLOAT || p_tab_elem->type= 
VAL_RATIONAL_FRACTION) 

{ 

bound= P4MAKE_FUNC_3("cc", p_tab_elem->term, 
1 0 check_term(P4Make_Rational(DEF_LOWER_BOUND)), 
check_term(P4Make_Rational(DEF_UPPER_BOUND))); 
term= P4AND(term, bound); 
} 

END_FOR_EACH_VAR(p_tab_elem, i) 

15 // « — KNJ: try removing the constraints on anonymous var's « — 
//FOR_EACH_ANON_VAR(anon) 

// bound= P4MAKE_FUNC_3("cc", anon, P4Make_Rational(DEF_LO WER_B OUND), 
;=j P4Make_Rational(DEF_UPPER_BOUND)); 
mi II term= P4AND(term, bound); 
2§j //END_FOR_EACH_ANON_VAR(anon) 

1» // « — KNJ: try removing the constraints on anonymous var's « — 

J° return(term); 

m' } 
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static P4TERM vars_multiple_of_precision_term() 
25ti { II return a term binding variables to be integer-multiples of their precision 
g // (e.g. int(_N), X= _N* X precision) 

II NOTE: This constraint excludes irrational variables (e.g. PI)! 

pi int i; 

M P4TERM term, t; 
30 TabElem *p_tab_elem; 

term= NULL; 

FOR_EACH_VAR(p_tab_elem, i) 

if (p_tab_elem->ongrid && (p_tab_elem->type= VAL_REAL || p_tab_elem->type= 
VAL_RATIONAL_FLOAT || p_tab_elem->type== VAL_RATIONAL_FRACTION)) 
35 {II for each variable, add: var_with_precision(Var, Precision). 

t= P4MAKE_FUNC_2("var_with_precision", p_tab_elem->term, 
check_term(P4Make_Rational(p_tab_elem->precision))); 

term= P4AND(term, t); 

} 

40 END_FOR_EACH_VAR(p_tab_elem, i) 
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return(term); 
} 

static P4TERM buffered_func_terms() 

{ // return the term containing the buffered functions (e.g. X= mean(X,Y) -> X= _R, 
mean(_R,X,Y), where mean(_R,X,Y) is buffered) 

retum(combine_teirns_array(funcTermBuf, funcTeimBuf_x, TRUE, FALSE, NULL, FALSE)); 
} 

static P4TERM get_exclude_solutions_term(int randomize) 

{ // return a term corresponding to the negation of all the previous solutions of independent 

var's e.g. (X=/= 4, Y=/=5, X=/= 10, Y=/=15). 

TabElem *p_tab_elem; 

P4TERM t, term; 

Value *p_soln_vec; 

int x_var, x_soln_vec; 

int i; 

char exclude_soln; 

term= NULL; 
exclude^soln^ TRUE; 
FOR_EACH_VAR(p_tab_elem, x_var) 

if (p_tab_elem->is_independent_var) 

{ // exclude only the variables to be used to generate uniq solns (e.q. 
enumerate variables) 

FOR_EACH_SOLN_VECTOR(p_soln_vec, x_soln_vec) 

if (randomize) // randomize the exclusion of solutions 

for(i=0, exclude_soln= FALSE; !exclude_soln && (i< 

SolnDiffWt); i++) 

exclude_soln= brandom(); 
if (exclude_soln && (t= get_value_term(&p_soln_vec[x_var]))) 

{ 

t= P4NEQ(p_tab_elem->term, t); 

term= P4AND(term, t); 

} 

END_FOR_EACH_SOLN_VECTOR(p_soln_vec, x_soln_vec) 
} 

END_FOR_EACH_VAR(p_tab_elem, x_var) 

return(term); 
} 

static P4TERM get_enum_ranges_term(int randomize) 

{ // return a term corresponding to the enumerated-ranges (which were stored in the 
enumRange buffer) 
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return(enumRangeTermBuf_CNT<=0? NULL: combine_terms_array(enumRangeTermBuf, 
enumRangeTermBuf_CNT, TRUE, randomize, NULL, FALSE)); 

} 

static P4TERM get_var_types_term(int randomize) 

{ // return a term corresponding to the combined var-types (e.g. int(X); neq_vars(X,Y)) 
(which were stored in the VARJTYPES buffer) 

return(varTypesTermBuf_CNT<=0? NULL: combine_terms_array(varTypesTermBuf, 
varTypesTermBuf_CNT, TRUE, randomize, NULL, FALSE)); 

} 

static P4TERM pregoal_addenda_terms() 

{ // return terms (e.g. -BOUND< X < BOUND) to be added before the current goal 
P4TERM term, types_term, bound__term, prec_term; 
P4TERM exclude_solns_term, var_interval_term; 

term= types_term= get_var_types_term (FALSE); 

bound_term= NULL; // set_var_bounds_term(); «-- KNJ: remove it for now «-- 
term= P4AND(term, bound_term); 

exclude_solns_term= RandomizeConstraints? get_exclude_solutions_term(TRUE): NULL; 
term= P4AND(term, exclude_solns_term); 
prec_term= vars_multiple_of_precision_term(); 
term= P4AND(term, prec_term); 

varjntervaljerm^ get_enum_ranges_term(RandomizeConstraints) ; 
term= P4AND(term, var_interval_term); 

return(term); 
} 

static P4TERM postgoal_addenda_terms() 

{ // return terms (e.g. intsplit/1, func-terms) to be added after the current goal 
P4TERM term, func_term; 
//P4TERM splitjerm; 

term^ func_term= buffered_func_terms(); 

// split_term= split_var_range_term(); // No need for splitting vars - and it may cause some 

overflow problems in VB 

// term= P4AND(term, splitjerm); 

retum(term); 

} 

static P4TERM append_func_defs(P4TERM term) 

{ // append (before/after the term ?) the function def s to the given term 
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// returns the appended term 
P4TERM t ? funcjerm; 

func_term= buffered_func_terms(); 

t= P4AND(term, funcjerm); // for now, append the funcjerm AFTER the given 

5 term 

IMT JuncTermBuf; // function-terms already consumed here - reset the 

functerms-buffer 

return(t); 
} 

1 0 static P4TERM insert_func_defs(P4TERM var_defs, P4TERM expr Jst) 
{ // insert the function def s between the var_defs and exprjst 

// returns P4AND(append_func_defs(var_defs), exprjst) 
P4TERM term; 

term= append_func_defs(var_defs); 
1S=h term= P4AND(term, exprjst); 

m return(term); 

S } 

4} static BOOLEAN process_call Jo_prolog(P4TERM goal) 

4* { // call Prolog IV with the given goal; return the result (i.e. TRUE/FALSE) of the call 

2dP // sets the BOOLEAN var resultFromProlog4 to the result. 

;L P4TERM pregoal, postgoal; 

'it z resultFromProlog4= 0; 

if (semErrorN 0) 
q return(FALSE); 

25* if(!goal) 

return(FALSE); 

if (pregoal= pregoal_addenda _terms()) // terms to add before goal 

goal = P4AND(pregoal, goal); 
if (postgoal= postgoal_addenda Jerms()) // terms to add after goal 
30 goal = P4AND(goal, postgoal); 

/* - p4 setof/3 & bagof/3 are buggy - hence we simulate them ourselves 
if(doBufferSoln) 

{ // call setof/3 - buffer (& order) all the solutions, return the result of call 
return(resultFromProlog4= find_setof_soln(goal)) ; 
35 } 
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else 
*/ 

P4MAKEC ALL(goal) ; 
resultFromProlog4= p4next_solution(); 

5 /* — Prints message incorrectly on time-limit-forced abortion 
if(resultFromProlog4=P4SESSION_ERROR) 

{printf("\n***Encountered error in process_call_to_prolog(), errno: %d***\n", 
p4errno) ; fflush(stdout) ; } 
*/ 

10 return(resultFromProlog4= P4SESSION_SOLUTION); 
} 

static P4TERM combine_terms_array(P4TERM terms[], long size_terms, int do_conjunct, int 
randomize, P4TERM var, int var_eq) 

{// returns a combined terms for the elements (or, if var is non-NULL: var= Element (if var_eq is 
1^ TRUE) (or, if var_eq is FALSE, var =/= Element)) from the given array of terms : 
J // use conjunct to combine terms if do conjunct is TRUE, disjunct 

Oi otherwise; 

U 1 // (randomize the array before combining if randomize is TRUE.) 

45 // (note that it shuffles the terms, when randomizing, in the given terms-buffer itself) 

2dB int i; 
4- P4TERM t, cmbnd Jerm; 
$ #define MAX_SHUFFLE (51) 

% if (size_terms<= 0) 
U return(NULL); 

2|t if (size_terms=l) 
q r eturn(t erms [ 0 ] ) ; 

if (randomize) 

{ 

int x, y, max_shuffle; 
30 P4TERM tmp; 

// graduated scale for max-shuffling 
max_shuffle= (size_terms<= 10)? 3* size_terms: 

(size_terms<= 20)? 2* size_terms+ 

10: 

35 MAX_SHUFFLE; 
for(i= 0; i< max_shuffle; i++) 

{ // shuffle the terms in the terms-buffer 
x= random()% size_terms; 
y= random()% size_terms; 
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tmp^ terms [x]; 
terms[x]= terms[y]; 
terms[y]= tmp; 

} 

5 > 

for(cmbnd_term= NULL, i= 0; i< size_terms; i++) 

{ 

t= !var? terms[i]: var_eq? P4EQ(var, terms[i]): P4NEQ(var, terms[i]); 
cmbnd_term= do conjunct? P4AND(cmbnd_term, t): P40R(cmbnd_term, t); 
10 } 

return(cmbnd_term) ; 
} 

static P4TERM combine_terms_list(List *terms_lst, int do_conjunct, int randomize, P4TERM 
var, int var_eq) 

15 {// returns a combined terms for the elements (or, if var is non-NULL: var= Element (if var_eq is 
TRUE) (or, if var_eq is FALSE, var =/== Element)) from the given list of terms : 
P1 // use conjunct to combine terms if do_conjunct is TRUE, disjunct 

~fl otherwise; 

m It (randomize the array before combining if randomize is TRUE.) 

2§] P4TERM t, cmbnd_term; 

*l3 if (! randomize) 

t < 

^ for(cmbnd_term= NULL; terms_lst; terms_lst= terms_lst->next) 

{ 

t= !var? terms_lst->elem: var_eq? P4EQ(var, terms_lst->elem): P4NEQ(var, 
terms_lst->elem); 

cmbnd_term= do_conjunct? P4AND(cmbnd_term, t): P40R(cmbnd_term, t); 
} 

fl } 
30" else 

{ // put the list-terms in an array, call combine_terms_array() with the array 
P4TERM *terms; 
List *lst; 
int i; 

35 for(i= 0, lst= termsjst; 1st; lst= lst->next, i++); 

if (! (terms= calloc(i, sizeof(P4TERM)))) 

{ 

printf("\n***Unable to calloc P4TERM-array in 
combinetermslistO* * *\n");fflush(stdout); 
40 return(NULL); // return NULL on error 

} 
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for(i= 0, lst= terms_lst; 1st; lst= lst->next, i++) 
terms[i]= lst->elem; 

cmbnd_term= combine_terms_array(terms, i, do_conjunct, randomize, var, var_eq); 
free(terms); 

} 

return(cmbnd_term) ; 
} 

static char *map_func_name(char *given_func_name) 

// check if the given function-name needs to be mapped e.g. gcd -> gcdtemp 
// return the properly mapped function name 

{ 

int i; 

for(i= 0; FuncRenameList[i].func_name && strcmp(given_func_name, 
FuncRenameList[i].func_name); i++); 

return(FuncRenameList[i] .flinc_name? FuncRenameList[i] .map_to_name: given_func_name) 
} 

static P4TERM unop_term(int op, P4TERM term) 

{ // make unary op term for standard op's, return the result term (e.g. "- X" => "uminus(Res, 
X)", return Res). 

// (Note: This function can handle only the ProloglV-standard unary operators; use 
make_functor() for nonstandard operators (e.g. abs, factorial) ) 
char *func; 
P4TERM res; 

if(!term) 

{ 

semError= ERR_NULL_TERM; 

return(NULL); 

} 

switch(op) 

{ // at some point, we need to decide between approx. & exact solvers (e.g. uminuslin vs 
uminus) 

case func= uselntervalSolver? ".-.": break; 
case'-f ! : func= uselntervalSolver? ".+.": "+"; break; 
default: return(NULL); 
} 

func= map func name(func); 
if (!(res= P4MAKE_FUNC_l(func, term))) 
{ 

semError= ERRMAKTNGFUNCTOR; 
return(NULL); 
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} 

return(res); 

} 

static P4TERM binop_arith_term(P4TERM term 1 , int op, P4TERM term2) 

{ // make binary op term for standard arithmetic op's, return the result term (e.g. " X + Y" => 

"plus(Res, X, Y)". 

// Returns (ptr to the term representing) the result of the computation rather than the 
Boolean status of the call. 

// Note that these are called using arity 3 Prolog IV predicates. 
// (Note: This function can handle only the ProloglV-standard binary operators; use 
make_functor() for nonstandard operators (e.g. mod, div) ) 
char *func; 
P4TERM res; 

if (Iterml || !term2) 
{ 

semError= ERR_NULL_TERM ; 

return(NULL); 

} 

switch(op) 

{ // at some point, we need to decide between approx. & exact solvers (e.g. minuslin vs minus) 

case '+': func= uselntervalSolver? ".+.": "+'*; break; 

case'-': func= uselntervalSolver? "-"; break; 

case '*': func= uselntervalSolver? ".*.": "*"; break; 

case'/': func= uselntervalSolver? "./.": 7"; break; 

case '%': func= "mod"; break; 

case 'W: func= "intdiv"; break; 

case ,A ': func=". A ."; break; // power/2 

// case func= "~"; break; 

default: return(NULL); 

} 

func= mapfuncname(func); 

if (!(res= P4MAKE_FUNC_2(func, terml, term2))) 

{ 

semError= ERRMAKINGFUNCTOR; 

return(NULL); 

} 

return(res); 

} 

static P4TERM binop_bool_term(P4TERM terml, int op, P4TERM term2) 

{ // make binary op term for standard boolean op's (e.g. " X, Y" => "and(X, Y)". 

char *func; 
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P4TERM res; 



if (Iterml || !term2) 
{ 

semError= ERR_NULL_TERM; 
retum(NULL); 

} 

switch(op) 

{ // at some point, we need to decide between approx. & exact solvers (e.g. minuslin vs minus) 
case EQ: func= "="; break; 
case NEQ: func= "dif '; break; 

case func= ","; break; ' // note that ,12 is different from and/2 in Prolog IV 

case ';': func= ";"; break; // note that ;/2 is different from or/2 in Prolog IV 

caseLT: func= uselntervalSolver? "It": "ltlin"; break; 

caseLE: func= uselntervalSolver? "le": "lelin"; break; 

caseGT: func= uselntervalSolver? "gt": "gtlin"; break; 

case GE: func= uselntervalSolver? "ge": "gelin"; break; 

default: return(NULL); 

} 

func= map_func_name(func); 

if (!(res= P4MAKE_FUNC_2(func, terml, term2))) 

{ 

semError= ERRMAKINGFUNCTOR; 

return(NULL); 

} 

return(res); 
} 

static P4TERM makeJermlist2term(List *lst) 

{ // convert the given list of P4-terms to Prolog IV list-term 

// recursive implementation to maintain the order of elem's 
// free the given list ?? 

return(lst? check_term(p4make_dot((P4TERM) lst->elem, make_termlist2term(lst->next))): 

check_term(p4make_nil())); 

} 

static P4TERM make_valslist2term(List *lst) 

{ // convert the given list of Values to Prolog IV list-term 

// recursive implementation to maintain the order of elem's 
return(lst? check_term(p4make_dot(get_value_term(lst->elem), make_valslist2term(lst->next))) : 
check_term(p4make__nil())); 

} 

static P4TERM make_int_rel(List *lst) 
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{ // make (& return) a conjunct of int/1 terms (e.g. int(X), int(Y)) for the given list 
P4TERM t, term; 

for(term= NULL; 1st; lst= lst->next) 
{ 

t= P4MAKE_FUNC_l("int", (P4TERM) lst->elem); 
term= P4AND(term, t); 
} 

// add the actual intrel-term to the VARTYPES buffer - so we can later manipulate it 
if (term) 

ADD_VAR_TYPES_TERM(term); 

// return just a placeholder since we already added the int_rel-term to the buffer 
return(P4TRUE); 

} 

static P4TERM make_real_rel(List *lst) 

{ // make (& return) a conjunct of real/1 terms (e.g. real(X), real(Y)) for the given list 
P4TERM t, term; 

for(term= NULL; 1st; lst= lst->next) 
{ 

t=P4MAKE_FUNC_l("real" > (P4TERM) lst->elem); 
term= P4AND(term, t); 
} 

// add the actual real rel-term to the VAR TYPES buffer - so we can later manipulate it 
if (term) 

ADD_VAR_TYPES_TERM(term); 

// return just a placeholder since we already added the real_rel-term to the buffer 

return(P4TRUE); 

} 

static P4TERM make_rational_rel(List *lst) 

{ // make (& return) a conjunct of real/1 & rational/1 terms (e.g. real(X), rational(X)) for the 
given list 
P4TERM t, term; 

for(term= NULL; 1st; lst= lst->next) 
{ 

t=P4MAKE_FUNC_l ("rational", (P4TERM) lst->elem); 
term= P4AND(term, t); 
} 
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// add the actual real_rel-term to the VAR_TYPES buffer - so we can later manipulate it 
if (term) 

ADD_V AR_T YPES_TERM(term) ; 

// return just a placeholder since we already added the real_rel-term to the buffer 

return(P4TRUE); 

} 

static P4TERM make_neqvars_rel(List *varslist) 

{ // make a term to enforce all var's in the list are different from each other; 

// put that term in VARS_TYPE_BUF for later use; return P4TRUE for now at end 
P4TERM t, term; 
List *listl, *list2; 

term= NULL; 

for(listl= varslist; list 1 ; listl= listl->next) 

for(list2= listl->next; list2; list2= list2->next) 

{ 

if (listl->elem && list2->elem) 

{ 

t= P4NEQ((P4TERM)listl->elem, (P4TERM)list2->elem); 

term= P4AND(term, t); 

} 

} 

// add the actual neqvars-term to the VAR_TYPES buffer - so we can later manipulate it 
if (term) 

ADD_VAR_TYPES_TERM(term); 

// return just a placeholder since we already added the neqvars-term to the buffer 

return(P4TRUE); 

} 

static P4TERM make_eqvars_rel(List *varslist) 

{ // make a term to enforce all var's in the list are equal to each other; 

// put that term in VARS_TYPE_BUF for later use; return P4TRUE for now at end 
P4TERM t, term; 
List *listl, *list2; 

term= NULL; 

for(listl= varslist; listl; listl= listl->next) 

for(list2= listl ->next; list2; list2= list2->next) 
{ 

if (listl ->elem && list2->elem) 

{ 
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t= P4EQ((P4TERM)listl->elem, (P4TERM)list2->elem); 
term= P4AND(term, t); 

} 

} 

// add the actual eqvars-term to the VARTYPES buffer - so we can later manipulate it 
if (term) 

ADD_VAR_TYPES_TERM(term); 

// return just a placeholder since we already added the eqvars-term to the buffer 
return(P4TRUE); 

} 

static P4TERM make_neqvarvals_rel(P4TERM var, List *valslist) 

{ // make a term to specify that the given var is not equal to any of the given values in the 
valslist; 

// put that term in VARS_TYPE_BUF for later use; return P4TRUE for now at end 
P4TERM t, term; 
List *listl; 

if (!var || Ivalslist) 

return(P4TRUE); 

term= NULL; 

for(listl= valslist; listl; listl= listl->next) 
{ 

t=P4NEQ(var, (P4TERM)listl->elem); 

term= P4AND(term, t); 

} 

// add the actual eqvars-term to the VAR_TYPES buffer - so we can later manipulate it 
if (term) 

ADD_VAR_TYPES_TERM(term); 

// return just a placeholder since we already added the eqvars-term to the buffer 
return(P4TRUE); 

} 

static P4TERM make_optimizable_rel(P4TERM rel) 

{ // optimize the given rel-term (for now, we just put it at the start of the clauses); 

// put that term in VARS_TYPE_BUF for later use; return P4TRUE for now at end 

if(!rel) 

return(P4TRUE); 

// add the actual term to the VAR_TYPES buffer - so we can later manipulate it 
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ADDVART YPESTERM(rei) ; 

// return just a placeholder since we already added the term to the buffer 
return(P4TRUE); 

} 

5 static P4TERM make_inlist(P4TERM var, List *lst) 

{ // make (& return) (var inlist 1st) constraint; (1st is list of P4 terms.); 

// (Obsolete: the translation uses inlist/1 e.g. "X in [a, b, 5]" => "X ~ inlist([a, b, 5])". 

// that approach provoked many problems in relations which expected 

constants e.g. gcd/2.) 

10 // Obsolete: return(P4MAKE_FUNC_2(" inlist", var, make_termlist2term(lst))); 

// The current translation essentially uses disjunction e.g. "X in [a, b, 5]." => (X= a; X= b; 

X= 5)." 

return(P4MAKE_FUNC_2("one_of var, make_termlist2term(lst))); 

} 

1 m static P4TERM make_fromlist(P4TERM var, List *lst) 

{ // make (& return) (var inlist 1st) constraint; (1st is list of P4 terms.); 
// some modifications/optimizations are made for randomization 
U1 // mark the given var as an independent variable 

4* TabElem *p_tab_elem; 
2(P P4TERM term; 



Us? 



if (!(p_tab_elem= get_term_tabelem(var))) 
P return(NULL); 

,n p_tab_elem->is_independent_var = TRUE; // all enumerated var's are considered 

p independent 

2Sj term= P4MAKE_FUNC_2( M random" 5 var, makejermlist2term(lst)); 

□ 

// add the actual term to the enumRangeTerm buffer - 

// so we can later randomize it (to help produce different-looking solutions) 

ADD_ENUM_RANGE_TERM(term) ; 

// return just a placeholder since we already added the enumRange term to the buffer 
30 return(P4TRUE); 

} 

static P4TERM make_notinlist(P4TERM var, List *lst) 

{ // make (& return) (var notinlist 1st) constraint; (1st is list of P4 terms.); 

// ?? should we try the conjunction e.g. "X notin [a, b, 5]." => (X=/= a, X=/= b. X=/= 5). M 

35 ??? 
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return(P4MAKE_FUNC_2("outlist", var, make_termlist2term(lst))); 
} 

static P4TERM make_interval(P4TERM left, int left_rel, P4TERM var, int right_rel, P4TERM 
right) 

{ // make (& return) interval constraint e.g. "4.5 < X <= 9" => "oc(X, 4.5, 9)"; "4.6 >= X 
2" => "oc(X, 2, 4.6)" 

// Note that this is different from an enumeration over an interval, 
char pred_name[3]; 
P4TERM term; 

if (!var || ((left_rel=LE || left_rel=LT) && (right_rel=GE || right_rel=GT)) || 

((left_rel==GE || left_rel=GT) && (right_rel=LE || right_rel=LT))) 
{ //e.g. "4.5 <X> 7.5" 
semError= ERRINVALIDINTERVAL; 
return(NULL); 

// build the predicate name from the given relationships 
pred_name[0]= (left_rel=LE || left_rel=GE)? 'c':V; 
pred_name[l]= (right_rel=LE || right_rel=GE)? , c , : , o f ; 
pred_name[2]= 0; 

term- P4MAKE_FUNC_3(pred_name, var, left, right); 

#ifdef WANT_ALL_SMALL_SOLUTIONS 

// while this ok to do (and gives good solutions), it leads to unnecessary 
undesirably small solutions in large quantity 

// — For now, don't use it — 
if (uselntervalSolver) 

{ // split the bounded var when using interval-solver 

char *split__pred; 

P4TERM t, lstjerm; 

TabElem *p_tab_elem; 

if (!(p_tab_elem= get_term_tabelem(var))) 
return(NULL); 

split_pred= (p_tab_elem->type= VAL_INTEGER)? "intsplit": "realsplit"; 
lst_term= p4make_dot(var, p4make_nil()); // X -> [X] 
t= P4MAKE_FUNC_3(split_pred, lstjerm, 
p4make_atom _from_cstring( ,, smallest_domain"), P4Make_Rational(p_tab_elem->precision)); 
term- P4AND(term, t); 
} 

#endif /* WANT_ALL_SMALL_SOLUTIONS */ 
return(term); 
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} 

static P4TERM make_enumeration(P4TERM left, int left_rel, P4TERM var, int rightrel, 
P4TERM right, P4TERM step) 

{ // make (& return) enumeration constraint e.g. "[4.5 < X <= 8 step 1]" => "(X=4.5; 
X=5.5;X=6.5;X=7.5)" 

// Note that this is different from interval, 
char *pred_name; 
TabElem *p_tab_elem; 
P4TERM term, adj left, adj_right; 

if (!var || !step || ((left_rel=LE || left_rel=LT) && (right_rel=GE || right_rel=GT)) || 
((left_rel=GE || left_rel=GT) && (right_rel=LE || right_rel=LT))) 
{ //e.g. "4.5 <X> 7.5" 
semError= ERR_iNVALID_INTERVAL; 
return(NULL); 
} 

if (!(p_tab_elem= get_term_tabelem(var))) 
return(NULL); 

p_tab_elem->is_independent_var = TRUE; // all enumerated var's are considered 

independent 

// Note: we don't care here which is min or max value - enumerate/4 takes care of that. 
pred_name= enumerateVarsRandomlyNoHistory? "enumeratejrandom": "enumerate"; 
if (p_tab_elem->type= VALINTEGER) 

pred_name= enumerateVarsRandomlyNoHistory? 
"enumerate_int_random" : "enumerate_int" ; 

adj Jeft= (left_rel=LT)? P4MAKE_FUNC_2("+" J left, 
check_term(P4Make_Rational(p_tab_elem->precision))): 

(left_rel=GT)? P4MAKE_FUNC_2("- ,? , left, 
check_term(P4Make_Rational(p_tab_elem->precision))): 

left; 

adj_right=(right_rel=LT)? P4MAKE_FUNC_2("+ ,, ) right, 
check_term(P4Make_Rational(p_tab_elem->precision))): 

(right_rel=GT)? P4MAKE_FUNC_2("- M , right, 
check_term(P4Make_Rational(p_tab_elem->precision))): 

right; 

term= P4MAKE_FUNC_4(pred_name, var, adj_left, adj_right, step); 

// add the actual enumerated-range term to the enumRangeTerm buffer - 

// so we can later randomize it (to help produce different-looking solutions) 

ADD_ENUM_RANGE_TERM(term); 

// return just a placeholder since we already added the enumRange term to the buffer 
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return(P4TRUE); 
} 

static P4TERM make_exterval(P4TERM left, int leftrel, P4TERM var, int right rel, P4TERM 
right) 

{ // make (& return) exterval constraint e.g. not("4.5 < X <= 9") => "outoc(X, 4.5, 9)"; not("4.6 
>= X > 2)" => "outoc(X, 2, 4.6)" 
char pred_name[6]; 

if (!var || ((left_rel=LE || left_rel=LT) && (right_rel=GE || right_rel=GT)) || 
((left_rel=GE || left_rel=GT) && (right_rel=LE || right_rel=LT))) 
{ // e.g. "4.5 < X > 7.5" 
semError= ERR_INVALID_INTERVAL; 
return(NULL); 

} 

strcpy(pred_name, "out"); 

pred_name[3]= (left_rel=LE || left_rel=GE)? *c':'o'; 
pred_name[4]= (right_rel=LE || right_rel=GE)? 'cVo'; 
pred_name[5]= 0; 

return(P4MAKE_FUNC_3(pred_name, var, left, right)); 
} 

static P4TERM make_functor(char *pred_name, List *arg_lst) 

{ // make & return ProloglV functor for the given predicate/args (e.g. given "mean", [X, Y] 
for "mean(X, Y)") 

// We allow no user-relations - only user-functions. 

// As such, we add 1 result var (at the leftmost position) to all the user-functions. 
// free the given list after use ?? 
int i, cnt, arity; 

P4TERM terms [MAX_ARITY+1 ], anon_result, funcjerm; 
List *lst; 

anon_result= NULL; 
cnt= 0; 

arity= arg lst? arg_lst->elem_cnt: 0; 
if (arity > MAX_ARITY) 

{ 

semError= ERRARITYTOOMANY ; 

return(NULL); 

} 

// convert given func/n to rel/n+1 e.g. X= mean(X, Y) -> X= _R, mean(_R, X, Y). 
terms[cnt++]= anon_result= check_term(p4make_var()); 
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for(i= 0, lst= argjst; i< MAX_ARITY && 1st; lst= lst->next,i++) 
terms[cnt++]= (P4TERM)lst->elem; 

pred_name= map_func_name(pred_name); 

func_term= check Jerm(p4vmake_functor(cnt, p4str2symbol(pred_name), terms)); 
ADD_funcTermBuf(func_term); // add func_term to funcTermBuf so we can generate code 
at end for it 
return(anon_result) ; 

} 



static P4TERM indexed_list_element(P4TERM list, List *index_lst) 

{ // return ProloglV term for the given list-indexed-term (e.g. L[l, 2]) 

// Translation scheme: List[I, J, K] => nth(K, nth(J, nth(I, List))). 
P4TERM nthelem, func term; 

if (! list || !index_lst) 

return(NULL); 

nth_elem= check_term(p4make_var()) ; 

func_term= P4MAKE_FUNC_3("nth", nth elem, index_lst->elem, list); 
ADD_funcTermBuf(func_term); // add func term to funcTermBuf so we can generate code 
at end for it 

return(index_lst->next? indexed Jist_element(nth_elem, index lst->next): nth_elem); 
} 

static P4TERM if_then_else(P4TERM cond, P4TERM thenjerm, P4TERM else term) 
{ // make & return ProloglV term for the given if-then-else construct 

// This is a backtrack-less-implementation of if-then-else. 

// if C then T else E => (C, T, !); E. 

return(else_term? P4IF_THEN_ELSE(cond, thenjerm, else term): P4IF_THEN(cond, 

then_term)); 

} 

static P4TERM if_then_elseif(P4TERM then_cond, P4TERM thenjerm, P4TERM else_cond, 
P4TERM elsejerm) 

{ // make & return ProloglV term for the guarded-if if-then-elseif construct 
// if TC then T elseif EC E => (TC, T); (EC, E). 

return(P4IF_THEN_ELSEIF(then_cond, thenjerm, else_cond, elsejerm)); 
} 
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%} 



%union 

{ 

int ival; 
float fval; 
double dval; 
char *string; 
List *list; 
P4TERM term; 

} 



%token 


<ival> 


INTNUM NOTIN SET IN SET FROM_SET NOT PI 


%token 


<ival> 


INT_PRED REAL PRED RATIONAL PRED 


FRACTION PRED LISTPRED FREEZE 


%token 


<ival> 


IF THEN ELSE ELSEIF SUCCEED FAIL SYMBOL PRED 


END VAR DEFS STEP 




%token 


<ival> 


EQVARSPRED NEQVARSPRED NEQVARVALSPRED 


OPTIMIZABLERELPRED 




%token 


<ival> 


ONGRID PRED OFFGRID PRED 


%token 


<string> 


REALNUM ATOM CONST VAR 


%token 


<ival> 


GTLT 


%token 


<ival> 


GE ">=" 


%token 


<ival> 


LE "<=" 


%token 


<ival> 


EQ "==" 


%token 


<ival> 


NEQ "=/=" 


%token 


<ival> 


EXRANGE START "[!" 


%left 


1.1 

5 




%left 


1 1 

3 




%nonassoc 






%nonassoc 


l_l 




%left 


II II t^l 1^,1 


_ll H^—tl 


%nonassoc 


T 




%left 


i_j_i i_t 




%left 






%left 


7 




%left 


'%' 'W 




%nonassoc 


NEG 




%left 







%left 

%type <term> prolog_expr expr expr_lst rel_expr range_expr type_list type_symbol 

%type <term> rel_expr arith_expr function p_list type_int type_real type_rational type_fraction 

%type <term> constant num_constant atom var if_then_else flow_expr type_expr base_expr 
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• 



%type <term> index type_eqvars type_neqvars type_neqvarvals type_optimizablerel 

%type <term> type_ongrid type_offgrid 

%type <ival> rel_op_lege 

%type <dval> number 

%type <list> list var_lst constant_lst 



prolog_expr : exprjst 7 {$$= 
(P4TERM)process_call_to_prolog($ 1 ) ; } 

| exprjst V END_VAR_DEFS 7 exprjst 7 
10 {$$= (P4TERM)process_call_tojrolog(insert_fiinc_defs($l ? $5));} 

| error 

{$$-NULL;} 



15 exprjst: exprjst 7 exprjst {$$= P4AND($1, $3);} 

| exprjst V exprjst {$$= P40R($1, $3);} 

| expr 



2Ql 



expr :*(' exprjst ')' 

| base_expr 
{$$- append_func_defs($l);} 



{$$= $2;} 



base_expr: rel_expr 



23f 



30 



flow_expr 
P4CUT;} 
P4TRUE;} 
P4FAIL;} 



rangeexpr 

flowexpr 

type_expr 



if_then_else 
| FREEZE 

I SUCCEED 

I FAIL 



{$$= 
{$$= 
{$$= 



35 



40 



type_expr 



typeint 

I type_real 
I type_rational 
| typefraction 
I type_list 
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u1 



35 



40 



I type_symbol 

I type_ongrid 

I type_offgrid 

I type_eqvars 

I type_neqvars 

I type_neqvarvals 

I type_optimizablerel 



if_then_else: IF expr THEN expr ELSE expr {$$= if_then_else($2, $4, $6);} 
10 | IF expr THEN expr ELSEIF expr THEN expr {$$= 

if_then_elseif($2, $4, $6, $8);} 

| IF expr THEN expr 

{$$= if_then_else($2, $4, NULL);} 



15 type_int : INT PRED varjst ')' {mark_term_list_type($2, 
VALJNTEGER); $$= make_int_rel($2);} 



type_real : REALPRED varjst ')' {mark_term_list_type($2, 
VAL_RATIONAL_FLOAT); $$= make_real_rel($2);} 

type_rational : RATIONAL_PRED varjst ')' {markjermjistjype($2, 
VAL_RATIONAL_FLOAT); $$= make_rational_rel($2);} 



type_fraction: FRACTION PRED varjst ')' {markjermjistjype($2, 
2$,, V AL RATION AL FRACTION) ; $$= make_real_rel($2);} 



typejist : LIST_PRED varjst ')' {$$=P4TRUE; 
P markjermjistjype($2, VAL LIST);} 

3© type_symbol : SYMBOL_PRED varjst ')' {$$=P4TRUE; 
markjermjistjype($2, VAL SYMBOL);} 



type_ongrid: ONGRDDPRED var ')' {$$=P4TRUE; 
set Jerm_on_grid($2) ; } 

type_offgrid: OFFGRID PRED var ')' {$$=P4TRUE; 
reset Jerm_on_grid($2) ; } 



type_eqvars : EQVARS_PRED varjst *)' {$$= make_eqvars_rel($2);} 

5 

type_neqvars: NEQVARS_PRED var_lst ')' {$$= make_neqvars_rel($2);} 
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type_neqvarvals: NEQVARVALSPRED var ',' list ')' 
make_neqvarvals_rel($2, $4);} 

type_optimizablerel: OPTIMIZABLERELPRED rel expr ')' 
make_optimizable_rel($2); } 



{$$= 



{$$= 



rel_expr : arith_expr '<' arith_expr {$$= binop_bool_term($l, LT, $3);} 

| arith_expr '>' arith_expr 
binop_bool_term($l, GT, $3);} 

| arith_expr "=" arith_expr 

EQ, $3);} 

| arith_expr "=/=" arith_expr 

NEQ, $3);} 

| arith_expr '=' arith_expr 
binop_bool_term($l, EQ, $3);} 

| arith_expr ">=" arith_expr 

GE, $3);} 

| arith_expr "<=" arith_expr 

LE, $3);} 

| '(' rel_expr ')' 

$2;} 

| NOT rel_expr 
{$$= P4NOT($2);} 
/* | function 

may not have relations */ 



{$$= 

{$$= binop_bool_term($l, 
{$$= binop_bool_term($l, 
{$$= 

{$$= binop_bool_term($l, 
{$$= binop_bool_term($l, 

{$$= 

{$$=$1;} -- 



range_expr 



arith_expr ']' 



$4);} 



'[* arith_expr rel_op_lege var rel_op_lege arith_expr ']' 

{$$= make_interval($2, $3, $4, $5, $6);} 
| " [ ! " arith_expr rel_op_lege var rel_op_lege arith_expr *]' 

{$$= make_exterval($2, $3, $4, $5, $6);} 
| '[' arith expr rel_op_lege var rel_op_lege arith_expr STEP 



{$$= make_enumeration($2, $3, $4, $5, $6, $8);} 
var FROM SET '[' list ']' {$$= make_fromlist($ 1 , 

var IN_SET '[' list ']' {$$= make_inlist($ 1 , $4);} 

var NOTIN_SET '[' list ']' {$$= make_notinlist($ 1 , $4);} 



rel_op_lege 
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{$$= LT;} 



| "<=•• 

{$$= LE;} 

I 

{$$= GT;} 

| ">=" 

{$$= GE;} 



pjist: '[' list ']' {$$= 
make_termlist2term($2);} 



list : list ',' arith_expr {$$= ncons($l, (void *)$3);} 

| arith_expr 
{$$= list((void *)$!);} 



arith_expr : arithexpr '+' arith_expr {$$=binop_arith_term($l, '+', $3);} 

| arith_expr '-' arith_expr {$$= 
binop_arith_term($l, $3);} 

| arith_expr V arith_expr {$$= 
binop_arith_term($l, V, $3);} 

| arith_expr '*' arith_expr {$$= 
binop_arith_term($l, '*', $3);} 

| arith expr IA ' arith_expr {$$= 
binop_arith_term($l, ,A ', $3);} 

| arith_expr '%' arith_expr {$$= 
make_functor("mod", cons((void *)$ 1 , list((void *)$3)));} 

| arith_expr 'W arith_expr {$$= 
make_functor("intdiv", cons((void *)$1, list((void *)$3)));} 

| '-' arith_expr %prec NEG {$$= unop_term('-', 

$2);} 

| arith_expr '!' 
{$$= mak^functorO" factorial", list((void *)$1));} 

| T arith_expr T {$$= 
make_functor("abs", list((void *)$2));} 

| '(' arith_expr ')' 

{$$= $2;} 

| function 

{$$=$1;} 

| index 

{$$=$1;} 

I PJist 

{$$=$1;} 
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constant 



{$$-$1;} 



var 



{$$=$1;} 



function : ATOM_CONST '(' list ')' 

| ATOM_CONST '(' ')' 
{$$= make_functor($l, NULL);} 



{$$= make_functor($l, $3);} 



index : var '[' list ']' 
indexed_list_element($l, $3);} 



{$$= 



var_lst : 
ncons($l,(void *)$3);} 

I 



var_lst ',' var 



var 



{$$= 



{$$= list((void *)$!);} 



constantjst: constant_lst V constant 

I constant 



{$$=ncons($l, (void *)$3);} 
{$$= list((void *)$!);} 



constant 



num_constant 
| atom 



num_constant: INTNUM {Value val; $$= 

check_term(p4make_lint($l)); val.type= VAL_INTEGER; val. value. integer= $1; 
insert_const($$, &val);} 

| REALNUM {Value val; 

$$= check_term(p4make_rational($l)); /* yylex passes string in yylval */ val.type= 
V AL RATION AL_FLO AT ; val.value.rational.real= atof($l); insert_const($$, &val);} 

| PI {Value 
val; $$= check_term(P4Make_Rational(PI_VAL)); val.type= V ALRATION ALFLO AT ; 
val.value.rational.real= PI VAL; insert_const($$, &val);} 



atom : ATOM_CONST 
check_term(p4make_atom_from_cstring($ 1 ));} 



{$$-- 
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var : VAR 

{$$= insert_var($l);} 
| '{' VAR V number'}' {$$= 

insert_var_with_precision($2, $4);} 

| ' {' VAR ',' number V number '} ' {$$= 

insert_var_with_precision($2, ((double)$4)/$6);} 



number: INTNUM {$$= (double)$l;} 

| REALNUM {$$= 

(double)atof(Sl); /* yylex passes string in yylval */} 

| PI {$$= 

(double)PI_VAL;} 



%% 

static int restart_parser() 
{ 

yyclearin; 
return(l); 

} 

static int restart_lexer() 
{ 

extern void yyrestart(FILE *); 

yyrestart(NULL); 
return(l); 

} 

static BOOLEAN init_solve_constraint(int keep_solns) 

{ // initialize all the buffers; if keep_solns is true, do not initialize the solns (& value) buffers 

// returns true if ok, false in error 
if (! StartProlog4Session(NULL)) 

return(FALSE); 
// initialize various data structures 
if (!keep_solns) 

{ 

INIT_valBuf; 
INIT_solnBuf; 

} 

INITjnExprBuf; 

INIT_vars; 

INlTfuncTermBuf; 
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INIT_anonVarBuf; 
INIT_constBuf; 
IMT_enumRangeTermBuf; 
INIT_varTypesTermBuf; 

// initilize parser/lexer states & data structures (if any) ... 
restart_lexer(); 
restart__parser(); 

return(TRUE); 
} 

int yyerror(char *s) 

{ // handle error 

// printf("syntax error\n"); 

semError= ERR_PARSE; 

return(O); 

} 

// some augmented functions for Prolog IV API - some of them may go away as we get 
newer, better API 

static P4SYMBOL p4str2symbol(char *str) // pseudo p4-routine 

{ // convert the given atomic (i.e. starting with lowercase e.g. 'aTom 1 ) string to Prolog IV symbol 

P4SYMBOL sym; 

if (p4cstring_to_symbol(str, &sym)) 

{ 

semError= ERR_GETTING_TERM; 

return(O); 

} 

return(sym); 
} 

static P4TERM p4make_atom_from_cstring(char *str) // pseudo p4-routine 

{ // convert the given atomic (i.e. starting with lowercase e.g. 'aTom') C-string to Prolog IV 

atomic term 

P4SYMBOL sym; 

if (p4cstring_to_symbol(str, &sym)) 

{ 

semError= ERR_GETTING_TERM ; 

return(NULL); 

} 

return(p4make_atom(sym)) ; 
} 

static int p4is_constant(P4TERM term) // pseudo p4-routine 
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{ // returns TRUE if the given term is constant 
int type; 

type= P4WHAT_IS(term); 

return(!(type=P4NULL || type=P4NOTATERM || type= P4VAR || type= 

P4UNEXPECTEDTERM)); 

} 

static P4TERM P4Make_Rational(double val) // pseudo p4-routine 

{ // KNJ: make (& return) term for the given double (rational) value 

charbuf[256]; 

sprintf(buf, "%.6f val); // maximum precision is limited to 6 positions 
return(make_rational_strfloat(buf)); 

} 

static P4TERM p4make_rational(char *floatstring) 

{ // by Pascal Bouvier (of Prologianet): Build a positive rational number from a C-string 
containing its decimal 

//representation (e.g. "4.5", "1.000000000", "24.02el997", ...) 
char buf[256]; 

strcpy(buf, floatstring); 
return(make_rational_strfloat(buf)); 

} 

static double p4val_as_double(P4TERM T) 

{ // by Pascal Bouvier (of Prologianet):Given a numeric Term, converts it as a double (with 
probable loss of precision) 
switch (P4WHAT_IS(T)) 

{ 

case P4INTEGER: case P4RATIONAL: 

return(nearest_ip_fpd(dereference(T))); 

default: 

return(- 1 1 1 1 1 . 1 1 1 ); /* in error */ 

} 

} 

static char *p4_symbol_to_cstring(P4SYMBOL symbol) 

{ // by Pascal Bouvier (of Prologianet): return the c-string rep. of the symbol 
return(symbol_shortidP(symbol)); 

} 
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* 



' hlP4API.h 
/* 

* hlP4API.h: Specification of high level API to Prolog IV 
* 

5 */ 

#include <windows.h> // necessary for VB stuff e.g. BSTR 

// The stdcall calling-convention is used for compatibility with VB 
#defineCCONV_stdcall 

#define DEF_PRECISION (0.01) 

10 #define DEFSOLNDIFFWT (1) 
#define DEFFLO ATJNTERV ALSTEP (0.1) 
#define DEF_INTEGER_INTERVAL_STEP (1) 
#define DEFUPPERB OUND (64000) 
#define DEFLO WERB OUND (-64000) 

15 #define DEF_GRID (TRUE) 

5 — s 

S typedef struct s_list 

0i { // ordered list 

Ul short elem_cnt; // total no. of elements (including this element) in the list 
41 void *elem; // this element (type to be inferred from the context) 

2§! struct s list *next; 

4» } List; 

L. typedef struct s_fiinctor 

~* { // structure to represent a Prolog IV functor (e.g. member/2) in C 
pq char *predicate; 
2j§T int arity; 

H } Functor; 

typedef struct s_rational 

{ // structure to represent a rational number 
double real; // real representation of a rational e.g. "4.5" 
30 long num; // numerator from A/B rep. of rational e.g. 9 from 9/2 

long den; // denominator from A/B rep. of rational e.g. 2 from 9/2 

} Rational; 

typedef struct s_bound // a bound for non-rational real 

{ 

35 char is_infmite; // flag - true if the real-val is infinite 

double val; // value of the non-infinite real 
} Bound; 
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• 



typedef struct s_real 

{ 

Bound lower, upper; 
} Real; 



// representation (bound) for non-rational real 



typedef struct s_val 
{ 



// type of the result (e.g. VALJNTEGER, VAL_LIST) 



int type; 
union { 

long integer; // e.g. 5 
1 0 Rational rational; // e.g. 9/2 = 4.5 

Real real; // e.g. (lower: 2.5, upper: 5) 

char *string; // atom e.g. area 

Functor functor; // e.g. add(X, Y) 

List *list; // value itself is a list of values e.g. [a, [x, y], 5] 

15 } value; 

} Value; 



2<K 



25 



II Types of value 
#define VAL_UNKNOWN 0 
#defme VAL_INTEGER 10 
#define VAL_RATIONAL_FLOAT 
#define VAL RATIONAL FRACTION 
#define VAL IRRATIONAL 



#define VALREAL 
#define VALSTRING 
#define VAL_LIST 
#defme VALJFUNCTOR 
#define VALSYMBOL 
#define VAL_VAR 
#defineDEF VAR TYPE 



15 



25 



20 



12 
13 
14 

// not used in the Value structure 



30 
35 
100 

VAL UNKNOWN 



// default type for untyped variables 



3& ' char * CCONV GetHLAPIVersion(); // return the current version of the Prolog HL API 
BSTR CCONV VBGetHLAPIVersion(); // VB wrapper for GetHLAPIVersionO 

// StartProlog4Session: starts Prolog IV, return true (1) if ok, false (0) otherwise. 

// p4hlapilib_file is the pathname to the high-level Prolog IV API library file 
// (MUST call one of: {StartProlog4Session, StartProlog4SessionSetStacks} before 
35 starting Prolog IV.) 

int CCONV StartProlog4Session(char *p4hlapilib_file); 

// StartProlog4SessionSetStacks: starts Prolog IV, return true (1) if ok, false (0) otherwise. 
// p4hlapilib_file is the pathname to the high-level Prolog IV API library file 
// heapsize is the heap-stack size; choicesize is the choice-stack size. 
40 // (MUST call one of: {StartProlog4Session, StartProlog4SessionSetStacks} before 

starting Prolog IV.) 
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int CCONV StartProlog4SessionSetStacks(char *p4hlapilib_file, long heapsize, long choicesize); 
// Error return- values from SolveConstraintQ (keep them all negative) 



#define ERR 


INITIALIZATION 


-10 




#defme ERR. 


CONSTRAINT TOO_LONG 




-15 


#define ERR 


GETTING TERM 


-20 




#define ERR. 


MAKING FUNCTOR 




-25 


#define ERR. 


"invalid INTERVAL 


-30 




#defme ERR. 


ARITY TOO MANY 




-35 


#define ERR. 


PARSE 




-40 


#define ERR~ 


NULL TERM 


-45 





// SolveConstraint: solve the given constraint (e.g. "X= Y+ 4, Y=2.") using a linear/interval 
solver as needed; 

// backtrack over the previous solution if the given constraint is NULL. 
// return true (=1) [false (=0)] if the constraint is [un]solvable; 
// returns negative integer in error (e.g. if the constraint could not be parsed), 
int CCONV SolveConstraint(char Constraint); 

// SolveConstraintLin: solve the given constraint (e.g. "X= Y+ 4, Y=2.") using a linear solver 
only; 

// backtrack over the previous solution if the given constraint is NULL. 
// return true (=1) [false (=0)] if the constraint is [un]solvable; 
// returns negative integer in error (e.g. if the constraint could not be parsed), 
int CCONV SolveConstraintLin(char Constraint); 

// SolveConstraintOrdered; solve the given constraint (e.g. ?, X= Y+ 4, Y=2."); using a 
linear/interval solver as needed 

// present the solutions conforming to the given order (e.g. ORDER_DIFF_TOGETHER) 

// backtrack over the previous solution if the given constraint is NULL. 

// returns, on first call (i.e. when constraint is non-NULL), (1+ 
the_total_count_of_solutions) (> 0) [false (=0)] if the constraint is [un]solvable; 

// (note that in case of constraints without variables (e.g. "4= 4."), 

total -no. -of-solutions is 0, though the constraint is provable.) 

// returns, on subsequent calls (i.e. when constraint is NULL), true (= 1) [false (=0)] if a 
solution exists [does not exist]; 

// returns negative integer in error (e.g. if the constraint could not be parsed), 
int CCONV SolveConstraintOrdered(char Constraint, int orderjype); 

// SolveConstraintOrderedNSolns: solve the given constraint (e.g. "X= Y+ 4, Y=2."); using a 
linear/interval solver as needed 

// solve to find the given maximum no. (= max_soln) of solutions 

// backtrack over the previous solution if the given constraint is NULL. 

// present the solutions conforming to the given order (e.g. ORDER_DIFF_TOGETHER) 

// returns, on first call (i.e. when constraint is non-NULL), (1 + 
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the_total_count_of_solutions) (> 0) [false (=0)] if the constraint is [un]solvable; 

// (note that in case of constraints without variables (e.g. "4= 4."), 

total-no.-of-solutions is 0, though the constraint is provable.) 

// returns, on subsequent calls (i.e. when constraint is NULL), true (= 1) [false (=0)] if a 
solution exists [does not exist]; 

// returns negative integer in error (e.g. if the constraint could not be parsed), 
int CCONV SolveConstraintOrderedNSolns(char Constraint, int order_type, int max_soln); 

// order-types 

#define NOORDER 0 

#define ORDER_DIFF_TOGETHER 1 0 

#define ORDER_LIKE_TOGETHER 20 

#define ORDERRANDOM 30 

#define ORDER JJNIQ_SOLUTIONS 40 

// set the precision for solving the constraint & for the solutions in the real domain 
// returns TRUE if ok, FALSE otherwise 
int CCONV SetPrecision(double precision); 

// set the weight to indicate how "different" the solutions must be from each other in 
Uniq_Soln_Order 

// (the higher the weight, the more the solutions are "different".) 
//returns TRUE if ok 
int CCONV SetSolnDiffWt(int soln_diff_wt); 

// fractionalize the rationals if do_fractionalize is TRUE; not otherwise (fractionalization may 
slow things down a bit.) 

int CCONV FractionalizeRational(int do_fractionalize); 

// IsFullyConstrained: returns TRUE if the given constraint is fully constrained (i.e. 
solvable & all variables are constant); FALSE otherwise (or in error) 
int CCONV IsFullyConstrained(char Constraint); 

// return TRUE (1) if the given variable is independent (i.e. specified in an enumeration); 
FALSE (0) otherwise 
int CCONV IsIndependentVar(char *var); 

// GetValue: return the ptr to the value (in Value structure) of the given variable (e.g. "Area") if 
known; 

Value * CCONV GetValue(char *var); 

// return type (e.g. VALJNTEGER) of the given Value; 
// returns VAL JJNKNOWN in error 
long CCONV GetValue_type(Value *val); 
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// return type (e.g. VAL INTEGER) of the given variable; 
// returns VALUNKNOWN in error 
long CCONV GetVarValue_type(char *var); 

5 // GetValue int: return integer value of the given Value structure 

// return ERRGETVALUEINT in error (e.g. given structure is not integer) 
long CCONV GetValue_int(Value * value); 
#defme ERR_GETVALUE_INT (- 1 1 1 1 1 1 765) 

// GetValue_rational: return rational value of the given Value structure 
1 0 // return <ERR_GETVALUE_RAT, ERRGETVALUEINT, ERR_GETVALUE INT> 

in error (e.g. given structure is not rational) 
Rational CCONV GetValue_rational(Value *value); 
#define ERR_GETVALUE_RAT (-11111 1765.9876) 

// return float rep. of the given rational Value 
15 double CCONV GetValue_rational_float(Value *val); 

// return numerator of the fractional rep. of the given rational Value 
W long CCONV GetValue_rational_numer(Value *val); 

// return denominator of the fractional rep. of the given rational Value 
%~ long CCONV GetValue_rational_denom(Value *val); 

2Ql II return real value (i.e. lower & upper bound) from the given non-rational Value 

ji structure; 

2 // return <1, 0> in error (e.g. given structure is not real) 

p Real CCONV GetValue_real(Value *val); 

P #defme ERR_GETVALUE_REAL (- 1 1 1 1 1 1 765 .9876) 

2fb* II return lower bound for the given non-rational real value 

^ // return ERR_GETVALUE_REAL in error or when the lower bound is infinite 

double CCONV GetValue_real_lower(Value *val); 

// return upper bound for the given non-rational real value 

// return ERR_GETVALUE_REAL in error or when the upper bound is infinite 
30 double CCONV GetValue_real_upper(Value *val); 

// GetValue_string: return (uniform) string representation of the given Value structure 

// return NULL in error (e.g. given structure is not valid) 
char * CCONV GetValue_string(Value *value); 

BSTR CCONV VBGetValue_string(Value *value); // VB wrapper for GetValue_string() 
35 // GetVarValue: return (uniform) string representation of the given variable 
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// return NULL in error 
char * CCONV GetVarValue(char *var); 

BSTR CCONV VBGetVarValue(char *var); // VB wrapper for GetVarValue() 

// return (uniform) string representation of the given variable in the value-buffer 
int CCONV GetVarValueBuf(char *var, int valuebuf_len, char valuebuf[]); // return length 
(>0) of value-string if ok; <= 0 in error 

// Print All VarVals: Print all the var's with their values in the given buffer; return ptr to the given 
buffer 

// (assumes the buffer is large enough to store all the var-value pairs.) 
char * CCONV PrintAllVarVals(char buf[]); 

BSTR CCONV VBPrintAUVarValsO; // VB wrapper (almost) for PrintAllVarVals() 

// Print All VarVals: Print all the var's with their values in an allocated buffer; return ptr to the 
given buffer 

// (assumes the buffer is large enough to store all the var-value pairs.) 
char * CCONV Print All VarVals Allocate(); 

// Compilexompile & load the given p4_filename (containing Prolog IV program) 

// return true (1) if the file compiled ok, false (0) in error 
int CCONV Compile(char *p4_filename); 
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